      OVERLAY(R2T,0,0)                                                   A   1
      PROGRAM MAIN(INPUT=66,OUTPUT=66,PUNCH=66,TAPE5=INPUT,TAPE6=        A   2
     1OUTPUT,TAPE7=PUNCH,TAPE1,TAPE9,TAPE10,TAPE4,TAPE2,TAPE3)           A   3
C     MAIN PROGRAM TO COMPUTE STEADY AND UNSTEADY AERODYNAMICS FOR       A   4
C     FLUTTER AND DYNAMIC RESPONSE ANALYSES OF ARRAYS OF MULTIPLE        A   5
C     SURFACES IN SUBSONI, TRANSONIC, AND SUPERSONIC FLOW.               A   6
C            BY ATLEE M. CUNNINGHAM, JR.                                 A   7
C            REFS. AIAA PAPERS 71-329, 73-670, 74-359  AND 75-99         A   8
C                  NASA CR-112264 (1973) AND NASA CR-144895 (1976)       A   9
C                                                                        A  10
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,   A  11
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,    A  12
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10) A  13
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH   A  14
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND     A  15
C                                                                        A  16
      COMMON /GAMA/ GAMMA                                                A  17
      COMMON /FLTLE/ TITLE(32)                                           A  18
      COMMON /ALPVCT/DUM1(4885)                                          A  19
      COMMON /COMM/LEAVE,IM,DUM2(10)                                     A  20
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10),  A  21
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),   A  22
     2 ETABAR(31,10),XIBAR(15,10), XIS(15,31,10), YBAR(15,10),           A  23
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),       A  24
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,   A  25
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10),  A  26
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                             A  27
      EQUIVALENCE ( NAME, OMDLIB, OMANRD, OMANAE, AEROPR, INTRPQ,        A  28
     1              FLTTER )                                             A  29
C                                                                        A  30
      DATA NAME /3LR2T/, ENDE /4HEND /                                   A  31
C                                                                        A  32
      CALL GSTART (3HR2T, MARSHA)                                        A  33
      FREQ = 0.0                                                         A  34
      IJOB = 1                                                           A  35
      LEAVE = 0                                                          A  36
      CALL LIB                                                           A  37
      CALL FREEFD                                                        A  38
C                                                                        A  39
      CALL OVERLAY ( OMDLIB,1,0 )                                        A  40
      IF ( LEAVE .GT. 0 ) GO TO 10                                       A  41
      GO TO 100                                                          A  42
C                                                                        A  43
   10 CALL EXIT                                                          A  44
C                                                                        A  45
  100 IJOB = IJOB + 1                                                    A  46
      CALL PROB                                                          A  47
C                                                                        A  48
      CALL OVERLAY ( OMANRD,2,0 )                                        A  49
      IF ( LEAVE .NE. 0 ) GO TO 10                                       A  50
C                                                                        A  51
C                                                                        A  52
      IF ( IOP1 .LE. 0 ) CALL OVERLAY ( OMANAE,3,0 )                     A  53
C                                                                        A  54
      IF ( IOP1 .NE. 0 ) REWIND NUNIT                                    A  55
      CALL OVERLAY ( AEROPR,4,0 )                                        A  56
C                                                                        A  57
      IF ( IOP1 .LT. 0 ) END FILE NUNIT                                  A  58
      IF ( IOP1 .NE. 0 ) REWIND NUNIT                                    A  59
C                                                                        A  60
 1000 CALL FORMFD                                                        A  61
      READ (5,1001) FEND                                                 A  62
      IF ( EOF(5) .NE. 0 ) GO TO 200                                     A  63
  150 CONTINUE                                                           A  64
 1001 FORMAT ( A4 )                                                      A  65
      IF ( FEND .NE. ENDE ) GO TO 100                                    A  66
C                                                                        A  67
  200 WRITE (6,1002)                                                     A  68
 1002 FORMAT (1H1,////,21X,28H " " " " " " " " " " " " "  ,/,            A  69
     1                 21X,28H "                       "  ,/,            A  70
     2                 21X,28H " THIS JOB IS COMPLETE  "  ,/,            A  71
     3                 21X,28H "                       "  ,/,            A  72
     4                 21X,28H " " " " " " " " " " " " "     )           A  73
C                                                                        A  74
      GO TO 10                                                           A  75
      END                                                                A  76
      SUBROUTINE PROB ( LEAVE )                                          B   1
      IF ( EOF(5) .EQ. 0 ) GO TO 20                                      B   2
   10 LEAVE = 9999                                                       B   3
      WRITE ( 6,15 )                                                     B   4
   15 FORMAT (1H1,//,33H     " " " " " " " " " " " " " "                 B   5
     1           , /,33H     "                         "                 B   6
     2           , /,33H     "  THIS JOB IS COMPLETE   "                 B   7
     3           , /,33H     "                         "                 B   8
     4           , /,33H     " " " " " " " " " " " " " "         )       B   9
   20 RETURN                                                             B  10
      END                                                                B  11
      SUBROUTINE FREEFD                                                  C   1
      RETURN                                                             C   2
      END                                                                C   3
      SUBROUTINE FORMFD                                                  D   1
      RETURN                                                             D   2
      END                                                                D   3
      SUBROUTINE LIB                                                     E   1
      RETURN                                                             E   2
      END                                                                E   3
      SUBROUTINE GSTART ( A, M )                                         F   1
      M = 1                                                              F   2
      WRITE (6,10)                                                       F   3
   10 FORMAT(1H1,14X,"  GENERAL DYNAMICS-CONVAIR AEROSPACE DIVISION ",   F   4
     1        //,14X,"    STEADY AND UNSTEADY AERODYNAMIC PROGRAM   ",   F   5
     2        //,14X,"  FOR SUBSONIC, TRANSONIC, AND SUPERSONIC FLOW",   F   6
     3        //,14X,"           WITH INTERFERENCE                  "  ) F   7
      RETURN                                                             F   8
      END                                                                F   9
      SUBROUTINE STATUS (IA)                                             G   1
      DIMENSION IA(20)                                                   G   2
      DO 10 I=1,20                                                       G   3
   10 IA(I) = 1                                                          G   4
      RETURN                                                             G   5
      END                                                                G   6
      FUNCTION FETE(I1,I2,X,BRPT)                                        H   1
C                                                                        H   2
C  FUNCTION TO PERFORM A LINEAR INTERPOLATION BETWEEN BREAK CHORD POINTS H   3
C                                                                        H   4
      DIMENSION BRPT(2,40)                                               H   5
      FETE=(BRPT(1,I1)-BRPT(1,I2))*(X-BRPT(2,I2))                        H   6
     1       /(BRPT(2,I1)-BRPT(2,I2))+BRPT(1,I2)                         H   7
C                                                                        H   8
      RETURN                                                             H   9
      END                                                                H  10
      SUBROUTINE CALMDS ( X, Y, BREF, NX, NY, ALP, DNWSH, DEF,           I   1
     1                    IOPT, NST, A, NXRO )                           I   2
C                                                                        I   3
C     SUBROUTINE TO CALCULATE  ALPHAS ------- IOPT = 1                   I   4
C                              DOWNWASH ----- IOPT = 2                   I   5
C                              DEFLECTIONS -- IOPT = 3                   I   6
C                                                                        I   7
      COMMON /ALPVCT/ COEF(20,200), XF(200), YF(200), NFS(10), NFS1(10), I   8
     1   GMASS(20,20), NSTRS, NMODES, DH, DW1, DW2, SPAN2(10),           I   9
     2   TAN12(10), TAN22(10), CAVG2(10), XR(10), YR(10)                 I  10
C                                                                        I  11
      DIMENSION X(NXRO,NY),   ALP(100,20), DNWSH(2,70,20), DEF(100,20),  I  12
     1          A(100), Y(NY)                                            I  13
C                                                                        I  14
C     NST IS THE STRUCTURAL SURFACE ASSIGNED TO                          I  15
C     THE CURRENT AERODYNAMIC SURFACE.                                   I  16
C                                                                        I  17
      NF3 = 1                                                            I  18
      DO 5 IS=1,NST                                                      I  19
      IF ( IS .LT. NST ) NF3 = NF3 + NFS(IS) + 3                         I  20
    5 CONTINUE                                                           I  21
C                                                                        I  22
      NF1 = NFS1(NST)                                                    I  23
      NF2 = NFS(NST)                                                     I  24
      SPAN = SPAN2(NST)                                                  I  25
      TAN1 = TAN12(NST)                                                  I  26
      TAN2 = TAN22(NST)                                                  I  27
      CAVG = CAVG2(NST)                                                  I  28
      IF ( IOPT-2 ) 10, 50, 100                                          I  29
C                                                                        I  30
   10 IR = 0                                                             I  31
      DO 20 J=1,NY                                                       I  32
C                                                                        I  33
      Y2 = 2.0*( Y(J)*BREF - YR(NST) )/SPAN - 1.0                        I  34
      CETA = CAVG - ( TAN1 - TAN2 )*Y2                                   I  35
      XLE  = XR(NST) + Y2*TAN1                                           I  36
C                                                                        I  37
      DO 20 I=1,NX                                                       I  38
      IR = IR + 1                                                        I  39
C                                                                        I  40
      X2   = 2.0*( X(I,J)*BREF - XLE )/CETA - 1.0                        I  41
C                                                                        I  42
      CALL MAGN ( X2, Y2, NF2, NMODES, XF(NF1), YF(NF1), DEF(1,1),       I  43
     1            DNWSH(1,1,1), COEF(1,NF3), 20 )                        I  44
C                                                                        I  45
      X2   = X2 + 0.001                                                  I  46
C                                                                        I  47
      CALL MAGN ( X2, Y2, NF2, NMODES, XF(NF1), YF(NF1), A,              I  48
     1            DNWSH(1,1,1), COEF(1,NF3), 20 )                        I  49
C                                                                        I  50
      DELT = 2000.0/CETA                                                 I  51
      DO 20 K=1,NMODES                                                   I  52
   20 ALP(IR,K) = DELT*( A(K) - DEF(K,1) )*DW1                           I  53
      GO TO 1000                                                         I  54
C                                                                        I  55
   50 IR = 0                                                             I  56
      DO 70 J=1,NY                                                       I  57
C                                                                        I  58
      Y2 = 2.0*( Y(J)*BREF - YR(NST) )/SPAN - 1.0                        I  59
C                                                                        I  60
      CETA = CAVG - ( TAN1 - TAN2 )*Y2                                   I  61
      XLE  = XR(NST) + Y2*TAN1                                           I  62
C                                                                        I  63
      DO 70 I=1,NX                                                       I  64
      IR = IR + 1                                                        I  65
C                                                                        I  66
      X2 = 2.0*( X(I,J)*BREF - XLE )/CETA - 1.0                          I  67
C                                                                        I  68
      CALL MAGN ( X2, Y2, NF2, NMODES, XF(NF1), YF(NF1), DEF(1,1),       I  69
     1            A, COEF(1,NF3), 20 )                                   I  70
C                                                                        I  71
      X2 = X2 + 0.001                                                    I  72
C                                                                        I  73
      CALL MAGN ( X2, Y2, NF2, NMODES, XF(NF1), YF(NF1), ALP(1,1),       I  74
     1            A, COEF(1,NF3), 20 )                                   I  75
C                                                                        I  76
      DELT = 2000.0/CETA                                                 I  77
      DO 70 K=1,NMODES                                                   I  78
      DNWSH(1,IR,K) = DELT*( ALP(K,1) - DEF(K,1) )*DW1                   I  79
   70 DNWSH(2,IR,K) = DEF(K,1)*DW2                                       I  80
      GO TO 1000                                                         I  81
C                                                                        I  82
  100 IR = 0                                                             I  83
      DO 120 J=1,NY                                                      I  84
C                                                                        I  85
      Y2 = 2.0*( Y(J)*BREF - YR(NST) )/SPAN - 1.0                        I  86
C                                                                        I  87
      CETA = CAVG - ( TAN1 - TAN2 )*Y2                                   I  88
      XLE  = XR(NST) + Y2*TAN1                                           I  89
C                                                                        I  90
      DO 120 I=1,NX                                                      I  91
      IR = IR + 1                                                        I  92
      X2 = 2.0*( X(I,J)*BREF - XLE )/CETA - 1.0                          I  93
C                                                                        I  94
      CALL MAGN ( X2, Y2, NF2, NMODES, XF(NF1), YF(NF1), A,              I  95
     1            ALP(1,1), COEF(1,NF3), 20 )                            I  96
C                                                                        I  97
      DO 120 K=1,NMODES                                                  I  98
  120 DEF(IR,K) = A(K)*DH                                                I  99
C                                                                        I 100
 1000 RETURN                                                             I 101
      END                                                                I 102
*----------------------------------------------------------------------  J   1
      SUBROUTINE SPLINE ( XF, YF, NF, C, D, IA, IB, NROWS, IND )         J   2
C                                                                        J   3
C     SUBROUTINE TO CALCULATE AND INVERT THE INTERPOLATION MATRIX FOR    J   4
C     SPLINE FIT OF HARDER AND DESMARAIS.                                J   5
C                                                                        J   6
      DIMENSION XF(NROWS), YF(NROWS), C(NROWS,NROWS), D(NROWS),          J   7
     1          IA(NROWS), IB(NROWS)                                     J   8
C                                                                        J   9
      N  = NF                                                            J  10
      N1 = NF+1                                                          J  11
      N2 = NF+2                                                          J  12
      N3 = NF+3                                                          J  13
C                                                                        J  14
      DO 40 J=1,N                                                        J  15
      C(J,J) = 0.0                                                       J  16
      J1 = J + 1                                                         J  17
      IF ( J1 .GT. N ) GO TO 15                                          J  18
      DO 10 I=J1,N                                                       J  19
      RIJ = ( XF(I) - XF(J) )**2 + ( YF(I) - YF(J) )**2                  J  20
      IF ( RIJ .EQ. 0.0 ) GO TO 100                                      J  21
   10 C(I,J) = RIJ*ALOG( RIJ )                                           J  22
   15 J1 = J - 1                                                         J  23
      IF ( J1 .LT. 1 ) GO TO 30                                          J  24
      DO 20 I=1,J1                                                       J  25
   20 C(I,J) = C(J,I)                                                    J  26
C                                                                        J  27
   30 C(N1,J) = 1.0                                                      J  28
      C(N2,J) = XF(J)                                                    J  29
      C(N3,J) = YF(J)                                                    J  30
      C(J,N1) = 1.0                                                      J  31
      C(J,N2) = XF(J)                                                    J  32
      C(J,N3) = YF(J)                                                    J  33
C                                                                        J  34
   40 CONTINUE                                                           J  35
C                                                                        J  36
      DO 50 J=N1,N3                                                      J  37
      DO 50 I=N1,N3                                                      J  38
   50 C(I,J) = 0.0                                                       J  39
C                                                                        J  40
      CALL INVRT ( C, D, IA, IB, N3, NROWS, +0, IND )                    J  41
C                                                                        J  42
      RETURN                                                             J  43
C                                                                        J  44
  100 WRITE (6,101) I, J                                                 J  45
  101 FORMAT (1H1,20H  STRUCTURAL POINTS , 2I4,26H HAVE IDENTICAL LOCATI J  46
     1ONS  )                                                             J  47
      CALL EXIT                                                          J  48
C                                                                        J  49
      END                                                                J  50
*----------------------------------------------------------------------  K   1
      SUBROUTINE MAGN ( X, Y, LFS, NMDS, XF, YF, VECT, D, C, NROWS )     K   2
C                                                                        K   3
      DIMENSION XF(NROWS), YF(NROWS), C(NROWS,NROWS), D(NROWS),          K   4
     1          VECT(NMDS)                                               K   5
C                                                                        K   6
      LFS3 = LFS + 3                                                     K   7
      DO 10 K=1,LFS                                                      K   8
      RK = ( X - XF(K) )**2 + ( Y - YF(K) )**2 + 1.0E-8                  K   9
   10 D(K) = RK*ALOG(RK)                                                 K  10
      D(LFS+1) = 1.0                                                     K  11
      D(LFS+2) = X                                                       K  12
      D(LFS+3) = Y                                                       K  13
C                                                                        K  14
      DO 30 J=1,NMDS                                                     K  15
      VECT(J) = 0.0                                                      K  16
      DO 20 K=1,LFS3                                                     K  17
   20 VECT(J) = VECT(J) + C(J,K)*D(K)                                    K  18
   30 CONTINUE                                                           K  19
C                                                                        K  20
      RETURN                                                             K  21
      END                                                                K  22
      SUBROUTINE CALCM ( XI, ETA, NC, NS, BMACH, TMACH, TN, A )          L   1
C                                                                        L   2
C     SUBROUTINE TO EVALUATE THE MACH NUMBER, TMACH, AT POINT XI, ETA,   L   3
C     FROM THE TSCHEBYCHEV POLYNOMIAL COEFICIENTS IN BMACH.              L   4
C                                                                        L   5
      DIMENSION  BMACH(NS,NC), TN(NS), A(NC)                             L   6
C                                                                        L   7
      TN(1) = 1.0                                                        L   8
      TN(2) = ETA                                                        L   9
      ETA2  = 2*ETA                                                      L  10
      DO 10 J=3,NS                                                       L  11
   10 TN(J) = ETA2*TN(J-1) - TN(J-2)                                     L  12
C                                                                        L  13
      DO 20 I=1,NC                                                       L  14
      A(I) = 0.0                                                         L  15
      DO 20 J=1,NS                                                       L  16
   20 A(I) = A(I) + TN(J)*BMACH(J,I)                                     L  17
C                                                                        L  18
      TN(2) = XI                                                         L  19
      XI2   = 2*XI                                                       L  20
      DO 30 I=3,NC                                                       L  21
   30 TN(I) = XI2*TN(I-1) - TN(I-2)                                      L  22
C                                                                        L  23
      TMACH = 0.0                                                        L  24
      DO 40 I=1,NC                                                       L  25
   40 TMACH = TMACH + TN(I)*A(I)                                         L  26
C                                                                        L  27
      RETURN                                                             L  28
      END                                                                L  29
      SUBROUTINE XMBY ( XM, BY, YY, BRPT, NEND )                         M   1
C                                                                        M   2
      DIMENSION BRPT(2,40)                                               M   3
C                                                                        M   4
      Y = ABS( YY )                                                      M   5
      DO 10 I=1,NEND                                                     M   6
      NUM=2*I                                                            M   7
      I1=NUM+1                                                           M   8
      IF (Y .LE. BRPT(2,I1)) GO TO 11                                    M   9
   10 CONTINUE                                                           M  10
      GO TO 12                                                           M  11
   11 I2=NUM-1                                                           M  12
      XLE=FETE(I1,I2,Y,BRPT)                                             M  13
C                                                                        M  14
      I1=NUM+2                                                           M  15
      I2=NUM                                                             M  16
      XTE=FETE(I1,I2,Y,BRPT)                                             M  17
C                                                                        M  18
      BY = 0.5*(XTE - XLE)                                               M  19
      XM = 0.5*(XTE + XLE)                                               M  20
C                                                                        M  21
      RETURN                                                             M  22
C                                                                        M  23
   12 WRITE (6,20) Y, ( (BRPT(I,I2), I=1,2 ), I2=1,I1 )                  M  24
   20 FORMAT (1H1, 19H    A VALUE FOR Y =,E15.7,20H  HAS BEEN SPECIFIED  M  25
     1       ,//, 52H     WHICH EXCEEDS THE INPUT GEOMETRY SPECIFICATION M  26
     2S , ///,    35H           X(I)                Y(I),/, (/,2E20.7) ) M  27
C                                                                        M  28
      CALL EXIT                                                          M  29
      END                                                                M  30
      SUBROUTINE TNXI ( TN, XI, JJ, MBAR, ICH )                          N   1
C                                                                        N   2
      DIMENSION TN(10,22), XI(22)                                        N   3
C                                                                        N   4
      IF ( ICH .GT. 4 ) GO TO 200                                        N   5
      DO 100 J=1,JJ                                                      N   6
      XI2 = 2.0*XI(J)                                                    N   7
      GO TO ( 1, 2, 3, 4 ), ICH                                          N   8
C                                                                        N   9
    1 F = 1.0                                                            N  10
      GO TO 10                                                           N  11
    2 F = SQRT ( 1.0 + XI(J) )                                           N  12
      GO TO 10                                                           N  13
    3 F = 1.0/SQRT( 1.0 - XI(J) )                                        N  14
      GO TO 10                                                           N  15
    4 F = SQRT ( (1.0+XI(J))/(1.0-XI(J)) )                               N  16
C                                                                        N  17
   10 TN(1,J) = 1.0*F                                                    N  18
      TN(2,J) = ( XI2 + 1.0 )*F                                          N  19
      TN(3,J) = ( (XI2 + 1.0)*XI2 - 1.0 )*F                              N  20
      IF ( MBAR .LT. 4 ) GO TO 100                                       N  21
C                                                                        N  22
      DO 20 I=4,MBAR                                                     N  23
   20 TN(I,J) = XI2*TN(I-1,J) - TN(I-2,J)                                N  24
C                                                                        N  25
  100 CONTINUE                                                           N  26
      GO TO 1000                                                         N  27
C                                                                        N  28
  200 DO 220 J=1,JJ                                                      N  29
C                                                                        N  30
      XI2 = 2*XI(J)                                                      N  31
      TN(1,J) = 1.0                                                      N  32
      TN(2,J) = XI2 + 1.0                                                N  33
C                                                                        N  34
      DO 210 I=3,MBAR                                                    N  35
  210 TN(I,J) = XI2*TN(I-1,J) - TN(I-2,J)                                N  36
C                                                                        N  37
  220 TN(1,J) = 1.0                                                      N  38
C                                                                        N  39
 1000 RETURN                                                             N  40
      END                                                                N  41
      SUBROUTINE UNETA ( UN, ETA, NS, NR, LS, ISTYPE, LSPAN )            O   1
C                                                                        O   2
      DIMENSION UN(15,31), ETA(61)                                       O   3
C                                                                        O   4
      IF ( LSPAN .GT. 4 ) GO TO 300                                      O   5
C                                                                        O   6
      IF ( ISTYPE .GT. 1 ) GO TO 110                                     O   7
C                                                                        O   8
      IF ( LS .NE. 0 ) GO TO 50                                          O   9
C                                                                        O  10
      DO 20 I=1,NS                                                       O  11
      UN(1,I) = 1.0                                                      O  12
      UM1     = 2.0*ETA(I)                                               O  13
      UN(2,I) = 2.0*ETA(I)*UM1 - 1.0                                     O  14
      DO 20 J=3,NR                                                       O  15
      UM1     = 2.0*ETA(I)*UN(J-1,I) - UM1                               O  16
   20 UN(J,I) = 2.0*ETA(I)*UM1       - UN(J-1,I)                         O  17
      GO TO 1000                                                         O  18
C                                                                        O  19
   50 DO 60 I=1,NS                                                       O  20
      UN(1,I) = 2.0*ETA(I)                                               O  21
      UM1     = 2.0*ETA(I) - 1.0                                         O  22
      UN(2,I) = 2.0*ETA(I)*UM1 - UN(1,I)                                 O  23
      DO 60 J=3,NR                                                       O  24
      UM1     = 2.0*ETA(I)*UN(J-1,I) - UM1                               O  25
   60 UN(J,I) = 2.0*ETA(I)*UM1       - UN(J-1,I)                         O  26
      GO TO 1000                                                         O  27
C                                                                        O  28
  110 NS2 = NS                                                           O  29
      A1 = 1.0                                                           O  30
      A2 = 1.0                                                           O  31
      IF ( LSPAN .EQ. 3 ) A2 = -1.0                                      O  32
      IF ( ISTYPE .EQ. 3 ) NS2 = NS/2                                    O  33
      DO 230 I=1,NS2                                                     O  34
      IF ( LSPAN .GT. 2 ) A1 = SQRT( 1.0 + A2*ETA(I) )                   O  35
      UN(1,I) = A1                                                       O  36
      UN(2,I) = A1*2.0*ETA(I)                                            O  37
      DO 230 J=3,NR                                                      O  38
  230 UN(J,I) = 2.0*ETA(I)*UN(J-1,I) - UN(J-2,I)                         O  39
C                                                                        O  40
      IF ( NS .EQ. 1 ) GO TO 1000                                        O  41
      IF ( ISTYPE .NE. 3 ) GO TO 1000                                    O  42
C                                                                        O  43
      NS3 = NS2+ 1                                                       O  44
      A3 = 1.0                                                           O  45
      IF ( LS .NE. 0 ) A3 = -1.0                                         O  46
      A1 = A1*A3                                                         O  47
C                                                                        O  48
      DO 240 I=NS3,NS                                                    O  49
      IF ( LSPAN .GT. 2 ) A1 = SQRT( 1.0 + A2*ETA(I) )*A3                O  50
      UN(1,I) = A1                                                       O  51
      UN(2,I) = A1*2.0*ETA(I)                                            O  52
      DO 240 J=3,NR                                                      O  53
  240 UN(J,I) = 2.0*ETA(I)*UN(J-1,I) - UN(J-2,I)                         O  54
C                                                                        O  55
      GO TO 1000                                                         O  56
C                                                                        O  57
  300 NS2 = NS                                                           O  58
      IF ( ISTYPE .EQ. 3 .AND. NS .NE. 1 ) NS2 = NS/2                    O  59
      A1 = 1.0                                                           O  60
      N1 = 1                                                             O  61
      N2 = NS2                                                           O  62
  310 DO 320 I=N1,N2                                                     O  63
      UN(1,I) = A1                                                       O  64
      ETA2    = 2.0*ETA(I)                                               O  65
      UN(2,I) = A1*ETA2                                                  O  66
      DO 320 J=3,NR                                                      O  67
  320 UN(J,I) = ETA2*UN(J-1,I) - UN(J-2,I)                               O  68
      IF ( N2 .EQ. NS ) GO TO 1000                                       O  69
      N1 = N2+1                                                          O  70
      N2 = NS                                                            O  71
      IF ( LS .NE. 0 ) A1 = -1.0                                         O  72
      GO TO 310                                                          O  73
C                                                                        O  74
 1000 RETURN                                                             O  75
      END                                                                O  76
      SUBROUTINE CHDTSS ( W, XIB, XIBAR, JJ, ICH, LSPAN, IND, KINT,      P   1
     1                    XMACH, BRPT, ETAS, JSUROP )                    P   2
C                                                                        P   3
C     SUBROUTINE TO COMPUTE THE CHORDWISE INTEGRATION WEIGHTING          P   4
C     FUNCTION FOR SUPERSONIC FLOW AND COMPUTE THE SUPERSONIC            P   5
C     PRESSURE BASE FUNCTION FROM CONICAL FLOW THEORY.                   P   6
C                                                                        P   7
      DIMENSION XIB(JJ), XIBAR(JJ), W(JJ), BRPT(2,4)                     P   8
C                                                                        P   9
      COMMON /ETC/ XIS(67), TRM(2,3), XSC(4), YSC(4)                     P  10
C                                                                        P  11
      IF ( JSUROP .EQ. 0 ) GO TO 300                                     P  12
      IF ( IND .NE. 0 ) GO TO 100                                        P  13
      IND  = 1                                                           P  14
      BETA = SQRT( XMACH*XMACH - 1.0 )                                   P  15
      XSC(1) = BRPT(1,1)                                                 P  16
      XSC(2) = BRPT(1,3)                                                 P  17
      XSC(3) = BRPT(1,2)                                                 P  18
      XSC(4) = BRPT(1,4)                                                 P  19
      YSC(1) = BRPT(2,1)                                                 P  20
      YSC(2) = BRPT(2,3)                                                 P  21
      YSC(3) = BRPT(2,2)                                                 P  22
      YSC(4) = BRPT(2,4)                                                 P  23
C                                                                        P  24
      A1 = XSC(2) - XSC(1)                                               P  25
      A2 = YSC(2) - YSC(1)                                               P  26
      A1 = A1/A2                                                         P  27
      A2 = ( XSC(4) - XSC(3) )/A2                                        P  28
      TRM(1,3) = A1                                                      P  29
      TRM(2,3) = A2                                                      P  30
C                                                                        P  31
      IF ( A1 .EQ. 0.0 ) GO TO 25                                        P  32
      IST = ICH                                                          P  33
      TRM(1,1) = BETA/A1                                                 P  34
C                                                                        P  35
      IF ( TRM(1,1) .GT. 1.0 ) GO TO 20                                  P  36
C                                                                        P  37
      TRM(1,2) = 7.0/( ( 1.75 + 1.0/TRM(1,1) )*BETA )                    P  38
      GO TO 30                                                           P  39
C                                                                        P  40
   20 TRM(1,2) = 4.0*TRM(1,1)/( BETA*SQRT( TRM(1,1)**2 - 1.0 ) )         P  41
C                                                                        P  42
      TRM(2,2) = 1.0 - 7.0/( BETA*TRM(1,2)*( 1.75 + 1.0/TRM(1,1) ) )     P  43
C                                                                        P  44
      GO TO 30                                                           P  45
C                                                                        P  46
   25 TRM(1,1) = 1.0 E+7                                                 P  47
      IST = 0                                                            P  48
C                                                                        P  49
   30 TRM(2,1) = 1.0 E+7                                                 P  50
      IF ( A2 .NE. 0.0 ) TRM(2,1) = BETA/A2                              P  51
C                                                                        P  52
  100 XLE = XSC(1) + ETAS*TRM(1,3)                                       P  53
      XTE = XSC(3) + ETAS*TRM(2,3)                                       P  54
      XM  = 0.5*( XTE + XLE )                                            P  55
      BY  = 0.5*( XTE - XLE )                                            P  56
C                                                                        P  57
      DO 110 J=1,JJ                                                      P  58
  110 XIS(J) = XM + BY*XIB(J)                                            P  59
C                                                                        P  60
      CALL SSFUNC( XSC, YSC, XIS, ETAS, JJ, BETA, TRM, IST, W )          P  61
C                                                                        P  62
      IF ( KINT .NE. 0 ) GO TO 200                                       P  63
C                                                                        P  64
      DO 120 J=1,JJ                                                      P  65
  120 W(J) = W(J)*SQRT( 1.0 - XIBAR(J)**2 )                              P  66
C                                                                        P  67
  200 GO TO 400                                                          P  68
C                                                                        P  69
  300 IF ( KINT .NE. 0 ) GO TO 340                                       P  70
      IF ( XIB(JJ) .EQ. XIBAR(JJ) ) GO TO 320                            P  71
C                                                                        P  72
      DO 310 J=1,JJ                                                      P  73
      GO TO ( 304, 303, 302, 301 ), ICH                                  P  74
C                                                                        P  75
  301 F = 1.0                                                            P  76
      GO TO 310                                                          P  77
  302 F = 1.0/SQRT( 1.0 + XIB(J) )                                       P  78
      GO TO 310                                                          P  79
  303 F = SQRT( 1.0 - XIB(J) )                                           P  80
      GO TO 310                                                          P  81
  304 F = SQRT( ( 1.0 - XIB(J) )/( 1.0 + XIB(J) ) )                      P  82
C                                                                        P  83
  310 W(J) = F*SQRT( 1.0 - XIBAR(J)**2 )                                 P  84
      GO TO 400                                                          P  85
C                                                                        P  86
  320 DO 330 J=1,JJ                                                      P  87
C                                                                        P  88
      GO TO ( 324, 323, 322, 321 ), ICH                                  P  89
C                                                                        P  90
  321 W(J) = SQRT( 1.0 - XIB(J)**2 )                                     P  91
      GO TO 330                                                          P  92
C                                                                        P  93
  322 W(J) = SQRT( 1.0 - XIB(J) )                                        P  94
      GO TO 330                                                          P  95
C                                                                        P  96
  323 W(J) = ( 1.0 - XIB(J) )*SQRT( 1.0 + XIB(J) )                       P  97
      GO TO 330                                                          P  98
C                                                                        P  99
  324 W(J) = ( 1.0 - XIB(J) )                                            P 100
C                                                                        P 101
  330 CONTINUE                                                           P 102
      GO TO 400                                                          P 103
C                                                                        P 104
  340 DO 350 J=1,JJ                                                      P 105
      GO TO ( 344, 343, 342, 341 ), ICH                                  P 106
C                                                                        P 107
  341 W(J) = 1.0                                                         P 108
      GO TO 350                                                          P 109
  342 W(J) = 1.0/SQRT( 1.0 + XIB(J) )                                    P 110
      GO TO 350                                                          P 111
  343 W(J) = SQRT( 1.0 - XIB(J) )                                        P 112
      GO TO 350                                                          P 113
  344 W(J) = SQRT( ( 1.0 - XIB(J) )/(  1.0 + XIB(J) ) )                  P 114
C                                                                        P 115
  350 CONTINUE                                                           P 116
C                                                                        P 117
  400 RETURN                                                             P 118
      END                                                                P 119
      SUBROUTINE SSFUNC ( XSC, YSC, XIS, ETAS, JJ, BETA, TRM, IST, P )   Q   1
C                                                                        Q   2
C     SUBROUTINE TO COMPUTE THE SUPERSONIC WEIGHTING FUNCTION FOR        Q   3
C     THE ASSUMED PRESSURE MODES OVER TRAPEZOIDAL SURFACES.              Q   4
C                                                                        Q   5
      DIMENSION XSC(4), YSC(4), XIS(JJ), TRM(2,3), P(JJ)                 Q   6
C                                                                        Q   7
      IF ( IST .NE. 0 ) GO TO 100                                        Q   8
C                                                                        Q   9
      DO 50 J=1,JJ                                                       Q  10
      A1 = BETA*( YSC(2) - ETAS )/( XIS(J) - XSC(2) )                    Q  11
      A2 = BETA*( YSC(2) + ETAS )/( XIS(J) - XSC(2) )                    Q  12
      P1 = 0.0                                                           Q  13
      P2 = 0.0                                                           Q  14
C                                                                        Q  15
      P(J) = 4.0/BETA                                                    Q  16
      IF ( A1 .GE. 1.0 ) GO TO 10                                        Q  17
C                                                                        Q  18
      P1 = 1.0 - 0.6366198* ASIN( SQRT( A1 ) )                           Q  19
C                                                                        Q  20
   10 IF ( A2 .GE. 1.0 ) GO TO 50                                        Q  21
C                                                                        Q  22
      P2 = 1.0 - 0.6366198* ASIN( SQRT( A2 ) )                           Q  23
C                                                                        Q  24
   50 P(J) = P(J)*( 1.0 - P1 - P2 )                                      Q  25
C                                                                        Q  26
      GO TO 1000                                                         Q  27
C                                                                        Q  28
  100 IF ( TRM(1,1) .LE. 1.0 ) GO TO 200                                 Q  29
C                                                                        Q  30
      DO 150 J=1,JJ                                                      Q  31
      A1 = 2.0                                                           Q  32
      B1 = XIS(J) - XSC(1)                                               Q  33
      IF ( B1 .LE. 0.0 ) GO TO 104                                       Q  34
      A1 = BETA*( ETAS - YSC(1) )/B1                                     Q  35
C                                                                        Q  36
  104 A2 = 2.0                                                           Q  37
      B1 = XIS(J) - XSC(2)                                               Q  38
      IF ( B1 .LE. 0.0 ) GO TO 106                                       Q  39
      A2 = BETA*( YSC(2) - ETAS )/B1                                     Q  40
C                                                                        Q  41
  106 P1 = 0.0                                                           Q  42
      P2 = 0.0                                                           Q  43
      P(J) = TRM(1,2)                                                    Q  44
C                                                                        Q  45
      IF ( A1 .GT. 1.0 ) GO TO 110                                       Q  46
C                                                                        Q  47
      P1 = TRM(2,2)*SQRT( 1.0 - A1*A1 )                                  Q  48
C                                                                        Q  49
  110 IF ( A2 .GT. 1.0 ) GO TO 150                                       Q  50
C                                                                        Q  51
      P2 = 1.0 - 0.6366198* ASIN( SQRT( A2 ) )                           Q  52
C                                                                        Q  53
  150 P(J) = P(J)*( 1.0 - P1 - P2 )                                      Q  54
C                                                                        Q  55
      GO TO 1000                                                         Q  56
C                                                                        Q  57
  200 B1 = 0.5/( TRM(1,1)*( 1.0 + TRM(1,1) ) )                           Q  58
C                                                                        Q  59
      DO 250 J=1,JJ                                                      Q  60
C                                                                        Q  61
      A1 = 2.0                                                           Q  62
      B2 = XIS(J) - XSC(1)                                               Q  63
      IF ( B2 .LE. 0.0 ) GO TO 204                                       Q  64
      A1 = BETA*( ETAS - YSC(1) )/B2                                     Q  65
C                                                                        Q  66
  204 A2 = 2.0                                                           Q  67
      B2 = XIS(J) - XSC(2)                                               Q  68
      IF ( B2 .LE. 0.0 ) GO TO 206                                       Q  69
      A2 = BETA*( YSC(2) - ETAS )/B2                                     Q  70
C                                                                        Q  71
  206 IF ( A2 .LT. 1.0 ) GO TO 210                                       Q  72
C                                                                        Q  73
      P(J) = TRM(1,2)/SQRT( 1.0 - ( A1/TRM(1,1) )**2 )                   Q  74
      GO TO 220                                                          Q  75
C                                                                        Q  76
  210 A3 = BETA*( ETAS - YSC(1) )/( XSC(2) + (YSC(2)-ETAS)*BETA-XSC(1) ) Q  77
C                                                                        Q  78
      P(J) = ( TRM(1,2)/SQRT( 1.0 - ( A3/TRM(1,1) )**2 ) )               Q  79
     1      *( 1.0 - SQRT( (1.0+A3)*(TRM(1,1)+A3)*B1 ) )                 Q  80
C                                                                        Q  81
  220 IF ( ABS(TRM(2,1)) .GE. 1.0 .OR. IST .GT. 2 ) GO TO 250            Q  82
      IF ( TRM(2,1) .LT. 0.0 ) GO TO 230                                 Q  83
C                                                                        Q  84
      B2 = XIS(J) - XSC(3)                                               Q  85
      ETA2 = ETAS - YSC(3)                                               Q  86
      GO TO 240                                                          Q  87
C                                                                        Q  88
  230 B2 = XIS(J) - XSC(4)                                               Q  89
      ETA2 = YSC(4) - ETAS                                               Q  90
C                                                                        Q  91
  240 IF ( B2 .LE. 0.0 .OR. ETA2 .EQ. 0.0 ) GO TO 250                    Q  92
C                                                                        Q  93
      A3 = ABS(TRM(2,1))                                                 Q  94
      A3 = ( ETA2 - B2*A3/BETA )/( ETA2*( 1.0 - A3 ) )                   Q  95
      IF ( A3 .GT. 0.999999 ) GO TO 250                                  Q  96
C                                                                        Q  97
      P(J) = P(J)*0.6366198* ASIN( SQRT( A3 ) )                          Q  98
C                                                                        Q  99
  250 CONTINUE                                                           Q 100
C                                                                        Q 101
 1000 RETURN                                                             Q 102
      END                                                                Q 103
      SUBROUTINE INVRT (C1,C2,N1,N2,N,NROWS,NTIME,IND)                   R   1
      DIMENSION  C1(NROWS,NROWS), C2(NROWS), N1(NROWS), N2(NROWS)        R   2
C                                                                        R   3
C     SUBROUTINE TO PERFORM DOUBLE PRECISION INVERSION OF A MATRIX C     R   4
C     USING SIMPLE ELIMINATION AND FULL SEARCH BEFORE ELIMINATION.       R   5
      IND = 0                                                            R   6
      IF (NTIME) 2,3,2                                                   R   7
    2 CALL STATUS (N1)                                                   R   8
      IT1 = N1(8)                                                        R   9
    3 D1 = 0.0                                                           R  10
      IF ( N .EQ. 1 ) GO TO 151                                          R  11
      II3 = N                                                            R  12
      II2 = N - 1                                                        R  13
      DO 20 J=1,N                                                        R  14
      N1(J) = J                                                          R  15
      N2(J) = J                                                          R  16
      DO 10 I=1,N                                                        R  17
      IF (D1 -  ABS(C1(I,J))) 5,10,10                                    R  18
    5 D1 =  ABS(C1(I,J))                                                 R  19
      I1 = I                                                             R  20
      J1 = J                                                             R  21
   10 CONTINUE                                                           R  22
   20 CONTINUE                                                           R  23
      DO 150 K6=2,N                                                      R  24
      IF (C1(I1,J1)) 50,30,50                                            R  25
   30 K5 = K6- 1                                                         R  26
      GO TO 1000                                                         R  27
   50 D1 = 1.0/C1(I1,J1)                                                 R  28
      D2 = C1(I1,II3)                                                    R  29
      D3 = C1(II3,J1)                                                    R  30
      D4 = C1(II3,II3)                                                   R  31
      DO 60 I=1,II2                                                      R  32
      C2(I) = C1(I,J1)                                                   R  33
      C1(I,J1)   = C1(I,II3)                                             R  34
      C1(I,II3)  = -C2(I)*D1                                             R  35
      D5         = -C1(I1,I)*D1                                          R  36
      C1(I1,I)   = C1(II3,I)                                             R  37
      C1(II3,I)  = D5                                                    R  38
   60 CONTINUE                                                           R  39
      C2(I1) = D3                                                        R  40
      C1(I1,J1)  = D4                                                    R  41
      C1(II3,J1) = -D2*D1                                                R  42
      C1(I1,II3) = -D3*D1                                                R  43
      C1(II3,II3)= D1                                                    R  44
      IF (II3-N) 70,110,110                                              R  45
   70 II4 = II3 + 1                                                      R  46
      DO 80 I=II4,N                                                      R  47
      C2(I) = C1(I,J1)                                                   R  48
      C1(I,J1)  = C1(I,II3)                                              R  49
      C1(I,II3) = C2(I)                                                  R  50
      D6   = C1(I1,I)*D1                                                 R  51
      C1(I1,I)  = C1(II3,I)                                              R  52
      C1(II3,I) = D6                                                     R  53
   80 CONTINUE                                                           R  54
      DO 100 J=II4,N                                                     R  55
      DO 90  I=1,II2                                                     R  56
      C1(I,J) = C1(I,J) - C2(I)*C1(II3,J)                                R  57
   90 CONTINUE                                                           R  58
  100 CONTINUE                                                           R  59
  110 I = N1(I1)                                                         R  60
      N1(I1) = N1(II3)                                                   R  61
      N1(II3) = I                                                        R  62
      I = N2(J1)                                                         R  63
      N2(J1) = N2(II3)                                                   R  64
      N2(II3) = I                                                        R  65
      D7 = 0.0                                                           R  66
      DO 140 J=1,II2                                                     R  67
      DO 130 I=1,II2                                                     R  68
      C1(I,J) = C1(I,J) + C2(I)*C1(II3,J)                                R  69
      D8 =  ABS(C1(I,J))                                                 R  70
      IF (D7 - D8) 120,130,130                                           R  71
  120 D7 = D8                                                            R  72
      I1 = I                                                             R  73
      J1 = J                                                             R  74
  130 CONTINUE                                                           R  75
  140 CONTINUE                                                           R  76
      II3 = II3 - 1                                                      R  77
      II2 = II2 - 1                                                      R  78
  150 CONTINUE                                                           R  79
  151 IF (C1(1,1)) 160,155,160                                           R  80
  155 K5 = N                                                             R  81
      GO TO 1000                                                         R  82
  160 C1(1,1) = 1.0/C1(1,1)                                              R  83
      IF ( N .EQ. 1 ) GO TO 249                                          R  84
      DO 170 J=2,N                                                       R  85
      C1(1,J) = C1(1,J)*C1(1,1)                                          R  86
  170 CONTINUE                                                           R  87
C     NOW THE FIRST ROW SOLUTION HAS BEEN OBTAINED.  THE REVERSE PRO-    R  88
C     CEDURE WILL BE STARTED.                                            R  89
C                                                                        R  90
      DO 210  K=2,N                                                      R  91
      KM1 = K - 1                                                        R  92
      DO 180 J=1,KM1                                                     R  93
      C2(J) = C1(K,J)                                                    R  94
      C1(K,J) = 0.0                                                      R  95
  180 CONTINUE                                                           R  96
      DO 200 J=1,N                                                       R  97
      DO 190 I=1,KM1                                                     R  98
      C1(K,J) = C1(K,J) + C1(I,J)*C2(I)                                  R  99
  190 CONTINUE                                                           R 100
  200 CONTINUE                                                           R 101
C     THIS COMPLETES THE SOLUTION FOR THE K'TH ROW.                      R 102
C                                                                        R 103
  210 CONTINUE                                                           R 104
C                                                                        R 105
C     NOW THE INVERSE HAS BEEN COMPUTED. THE NEXT STEPS WILL RE-ARRANGE  R 106
C     IT BACK INTO ITS ORIGINAL ORDER.                                   R 107
      DO 240 J=1,N                                                       R 108
      J1 = N1(J)                                                         R 109
      N1(J) = J                                                          R 110
  215 IF (J1 - J) 220,240,220                                            R 111
  220 DO 230 I=1,N                                                       R 112
      D1 = C1(I,J)                                                       R 113
      C1(I,J) = C1(I,J1)                                                 R 114
      C1(I,J1) = D1                                                      R 115
  230 CONTINUE                                                           R 116
      K = N1(J1)                                                         R 117
      N1(J1) = J1                                                        R 118
      J1 = K                                                             R 119
      GO TO 215                                                          R 120
  240 CONTINUE                                                           R 121
      DO 248 I=1,N                                                       R 122
      I1 = N2(I)                                                         R 123
      N2(I) = I                                                          R 124
  242 IF (I1 - I) 244,248,244                                            R 125
  244 DO 246 J=1,N                                                       R 126
      D1 = C1(I,J)                                                       R 127
      C1(I,J) = C1(I1,J)                                                 R 128
      C1(I1,J) = D1                                                      R 129
  246 CONTINUE                                                           R 130
      K = N2(I1)                                                         R 131
      N2(I1) = I1                                                        R 132
      I1 = K                                                             R 133
      GO TO 242                                                          R 134
  248 CONTINUE                                                           R 135
C     THE MATRIX HAS BEEN RE-ARRANGED IN ITS ORIGINAL ORDER.             R 136
C     IF NTIME N.E. ZERO, THEN THE INVERSION TIME IS PRINTED OUT.        R 137
  249 IF (NTIME) 250,270,250                                             R 138
  250 CALL STATUS (N1)                                                   R 139
      TIME=(N1(8)-IT1)*0.01                                              R 140
      WRITE (6,260) N,TIME                                               R 141
  260 FORMAT (1H1,////,42H   THE TOTAL TIME FOR INVERTING THE MATRIX,//  R 142
     1                 12H   OF ORDER ,I3,6H , IS ,E12.5,8H SECONDS)     R 143
      GO TO 270                                                          R 144
 1000 WRITE (6,1001) K5                                                  R 145
 1001 FORMAT (1H1, 4X,57H THE REDUCED MATRIX WAS FOUND TO BE SINGULAR ON R 146
     1 ITERATION,I4 )                                                    R 147
      IND = 1                                                            R 148
  270 RETURN                                                             R 149
      END                                                                R 150
      OVERLAY(R2T,1,0)                                                   S   1
      PROGRAM    OMDLIB                                                  S   2
C                                                                        S   3
      COMMON /COMM/ LEAVE, DUM1(11)                                      S   4
      COMMON /FLTLE/ TITLE(32)                                           S   5
      REAL LI, INT                                                       S   6
      DATA LI/4HLIBR/, INT/4HINTQ/, FLT /4HFLTR/                         S   7
C                                                                        S   8
      DUM1(11) = 0.0                                                     S   9
C                                                                        S  10
      CALL FORMFD                                                        S  11
      READ (5,10) TITLE(1)                                               S  12
   10 FORMAT (A4)                                                        S  13
C                                                                        S  14
      IF ( TITLE(1) .EQ. LI ) GO TO 20                                   S  15
      IF ( TITLE(1) .EQ. INT ) LEAVE = -2                                S  16
      IF ( TITLE(1) .EQ. FLT ) LEAVE = -1                                S  17
      BACKSPACE 5                                                        S  18
      GO TO 100                                                          S  19
C                                                                        S  20
   20 CALL RDLIB (LEAVE)                                                 S  21
C                                                                        S  22
      IF ( LEAVE .EQ. 0 ) CALL TRNSMD                                    S  23
C                                                                        S  24
      DUM1(11) = 1.0                                                     S  25
C                                                                        S  26
  100 CONTINUE                                                           S  27
      END                                                                S  28
      SUBROUTINE RDLIB (LEAVE)                                           T   1
C                                                                        T   2
C     SUBROUTINE TO READ THE BY7 MODES AND THE DATA FOR SURFACE          T   3
C     SPLINE INTERPOLATION.                                              T   4
C                                                                        T   5
      COMMON /ALPVCT/ COEF(20,200), XF(200), YF(200), NFS(10), NFS1(10), T   6
     1   GMASS(20,20), NSURF, NMODES, DH, DW1, DW2, SPAN2(10),           T   7
     2   TAN12(10), TAN22(10), CAVG2(10), XR(10), YR(10)                 T   8
C                                                                        T   9
      COMMON /MANE2/  H(200,20), IF(150,12), AMASS(200), NF, NUNIT,      T  10
     1   NMDTP, L1, L2, L3, L4, XMODE, XMASS, BREF, RHO, XIS(2,10),      T  11
     2   XOS(2,10), YCS(2,10), C(53,53), D(200), XFP(200), YFP(1120)     T  12
      INTEGER KFM(8)                                                     T  13
C                                                                        T  14
      CALL FREEFD                                                        T  15
C                                                                        T  16
      READ (5,10) NF, NSURF, NMODES, NUNIT, NMDTP, L1, L2, L3, L4        T  17
      READ (5,11) XMODE, XMASS, DH, DW1, DW2, BREF, RHO                  T  18
   10 FORMAT ( 6I10 )                                                    T  19
   11 FORMAT ( 6F10.0 )                                                  T  20
C                                                                        T  21
      IF ( NF .LT. 201 ) GO TO 20                                        T  22
C                                                                        T  23
      WRITE ( 6,15 ) NF                                                  T  24
   15 FORMAT (1H1,"   THE STRUCTURE SIZE IS GREATER THAN 200, NF=",I10)  T  25
      GO TO 999                                                          T  26
C                                                                        T  27
   20 IF ( NSURF .LT. 11 ) GO TO 30                                      T  28
C                                                                        T  29
      WRITE ( 6,25 ) NSURF                                               T  30
   25 FORMAT (1H1,"  THE NUMBER OF SURFACES EXCEED 10, NSURF=",I10 )     T  31
      GO TO 999                                                          T  32
C                                                                        T  33
   30 IF ( NMODES .LT. 21 ) GO TO 40                                     T  34
C                                                                        T  35
      WRITE ( 6,35 ) NMODES                                              T  36
   35 FORMAT (1H1,"  THE NUMBER OF MODES EXCEED 20, NMODES=", I10 )      T  37
      GO TO 999                                                          T  38
C                                                                        T  39
   40 IF ( NUNIT .EQ. 0 ) GO TO 50                                       T  40
      IF ( NUNIT .LT. 14 .AND. NUNIT .GT. 8 ) GO TO 50                   T  41
C                                                                        T  42
      WRITE ( 6,45 ) NUNIT                                               T  43
   45 FORMAT (1H1,"  THE BY7 MODE TAPE UNIT IS NOT 9 TO 13, NUNIT=",I10) T  44
      GO TO 999                                                          T  45
C                                                                        T  46
   50 WRITE ( 6,55 ) NF, NSURF, NMODES                                   T  47
   55 FORMAT (1H1,16X," LIBRARY DATA FOR THE MODES AND MASSES ",//,      T  48
     1            16X,"    NUMBER OF STRUCTURAL POINTS = ",I3,//,        T  49
     2            16X,"    NUMBER OF LIFTING SURFACES  = ",I3,//,        T  50
     3            16X,"    NUMBER OF NATURAL MODES     = ",I3,//  )      T  51
C                                                                        T  52
      IF ( L1 .NE. 0 ) GO TO 70                                          T  53
      WRITE ( 6,60 )                                                     T  54
   60 FORMAT (1H ,16X," THE MODES AND MASSES ARE OUTPUT FROM BY7", // )  T  55
      GO TO 80                                                           T  56
C                                                                        T  57
   70 WRITE ( 6,75 )                                                     T  58
   75 FORMAT (1H ,16X," THE MODES AND MASSES ARE OUTPUT FROM C28", // )  T  59
C                                                                        T  60
   80 WRITE ( 6,85 ) XMODE, XMASS, DH, DW1, DW2                          T  61
   85 FORMAT (1H ,16X," THE SCALING CONSTANTS ARE AS FOLLOWS ", //,      T  62
     1            18X," XMODE = ",E14.7,     " XMASS = ",E14.7, //,      T  63
     2            18X," DH    = ",E14.7,     " DW1   = ",E14.7, //,      T  64
     3            18X," DW2   = ",E14.7, // )                            T  65
C                                                                        T  66
      IF ( L4 .EQ. 0 ) GO TO 100                                         T  67
      WRITE ( 6,86 )                                                     T  68
   86 FORMAT (1H ,10X,"  THE PITCH AND ROLL MODES WILL BE COMPUTED ",/   T  69
     1           ,10X,"  AS MODES (NMODES+1) AND (NMODES+2). ",//    )   T  70
C                                                                        T  71
  100 READ (5,1) KFM                                                     T  72
      READ (5,KFM)  ( XF(I), YF(I), I=1,NF )                             T  73
    1 FORMAT (8A10)                                                      T  74
      WRITE( 6,110) ( XF(I), YF(I), I=1,NF )                             T  75
  110 FORMAT (1H1,//,20X," THE STRUCTURAL POINT LOCATIONS",///, 4X,      T  76
     1  3 ("   XS(I)       YS(I)    " ), //,( 4X, 6E12.4 ) )             T  77
      WRITE ( 6,11 )                                                     T  78
      DO 120 I=1,NSURF                                                   T  79
      READ ( 5,10 ) NFF, ( IF(J,I), J=1,NFF )                            T  80
      NFS(I) = NFF                                                       T  81
      READ ( 5,11 )  XIS(1,I), XIS(2,I), YCS(1,I),                       T  82
     1               XOS(1,I), XOS(2,I), YCS(2,I)                        T  83
  112 FORMAT (1H ,//, 5X," WING SURFACE " )                              T  84
      WRITE ( 6,115 ) I, NFF, ( IF(J,I), J=1,NFF )                       T  85
  115 FORMAT (1H ,//,10X," SURFACE ",I2," HAS ",I3," STRUCTURAL POINTS", T  86
     1            //,10X," THE POINTS ARE ",//, ( 5X,14I5 ) )            T  87
  120 WRITE ( 6,111 ) YCS(1,I), YCS(2,I), XIS(1,I), XOS(1,I),            T  88
     1                XIS(2,I), XOS(2,I)                                 T  89
  111 FORMAT (1H ,///, 17X,                                              T  90
     1   "       INBOARD                 OUTBOARD ",//,12X," Y     = ",  T  91
     2   E11.4, 10X, E15.4, //,12X," X(LE) = ",E11.4, 10X,E15.4,         T  92
     3                      //,12X," X(TE) = ",E11.4, 10X,E15.4  )       T  93
C                                                                        T  94
C                                                                        T  95
      NF2 = NF                                                           T  96
      IF ( L3 .EQ. 0 ) GO TO 170                                         T  97
      IF ( L3 .LT. 201  .AND. L3 .GT. 0 ) GO TO 140                      T  98
      WRITE ( 6,130 ) L3                                                 T  99
  130 FORMAT (1H1,"   THE NUMBER OF ZERO COORDINATES, L3 = ",I4,         T 100
     1         //,"   IS OUT OF BOUNDS. " )                              T 101
      GO TO 999                                                          T 102
  140 IF ( L3 .LE. NF ) GO TO 150                                        T 103
      WRITE ( 6,145 ) L3, NF                                             T 104
  145 FORMAT (1H1,"   THE NUMBER OF MODIFIED COORDINATES, L3= ",I4,      T 105
     1         //,"   EXCEEDS THE TOTAL NUMBER, NF= ",I4 )               T 106
      GO TO 999                                                          T 107
C                                                                        T 108
  150 READ ( 5,10 ) NF2, ( IF(I,11), I=1,L3 )                            T 109
      IF ( NF2 .LT. 201 .AND. NF2 .GT. 0 ) GO TO 160                     T 110
      WRITE ( 6,155 ) NF2                                                T 111
  155 FORMAT (1H1,"   THE NUMBER OF INPUT MODE COORDINATES IS ",         T 112
     1         //,"   OUT OF BOUNDS, NF2 = ",I4 )                        T 113
      GO TO 999                                                          T 114
C                                                                        T 115
  160 WRITE ( 6,165 ) NF2, ( IF(I,11), I=1,L3 )                          T 116
  165 FORMAT (1H ,//,10X," THE NUMBER OF INPUT MODE COORDINATES = ",I4,  T 117
     1            //,10X,"   THE COORDINATES TO BE MODIFIED ARE ",       T 118
     2            //, (5X,14I5)  )                                       T 119
C                                                                        T 120
  170 READ (5,1) KFM                                                     T 121
      IF ( L2 .NE. 0 ) READ (5,KFM)( AMASS(I), I=1,NF2 )                 T 122
      DO 180 N=1,NMODES                                                  T 123
      IF ( L1 .EQ. 0 ) READ (5,11)                                       T 124
      READ (5,KFM) ZN                                                    T 125
      READ (5,KFM)     ( H(I,N), I=1,NF2 )                               T 126
      IF ( ZN .EQ. 0. ) ZN = 1.0                                         T 127
      RZN = 1.0/ZN                                                       T 128
      DO 180 I=1,NF2                                                     T 129
  180 H(I,N) = RZN*H(I,N)                                                T 130
C                                                                        T 131
      IF ( L2 .NE. 0 .AND. L3 .NE. 0 ) CALL ZEROS ( AMASS, H, IF(1,11),  T 132
     1                                      L3, NF, NF2, NMODES )        T 133
C                                                                        T 134
      IF ( L2 .EQ. 0 .AND. L3 .NE. 0 ) CALL ZEROS ( H(1,1), H(1,2),      T 135
     1                                 IF(1,11), L3, NF, NF2, NMODES-1 ) T 136
C                                                                        T 137
      IF ( NF .LT. 0 ) GO TO 999                                         T 138
C                                                                        T 139
  200 IF ( L2 .EQ. 0 ) GO TO 205                                         T 140
C                                                                        T 141
      WRITE ( 6,210 ) ( AMASS(I), I=1,NF )                               T 142
  210 FORMAT (1H1,26X,//," THE MASS DATA ",//, ( 2X, 5E15.7 ) )          T 143
  205 WRITE ( 6,215 )                                                    T 144
  215 FORMAT (1H1,22X,//," THE MODE DEFLECTIONS" )                       T 145
C                                                                        T 146
      DO 240 N=1,NMODES                                                  T 147
  240 WRITE ( 6,220 ) N, ( H(I,N), I=1,NF )                              T 148
  220 FORMAT (1H ,26X,//," MODE SHAPE ",I2,//, ( 2X, 5E15.7 ) )          T 149
      GO TO 1000                                                         T 150
C                                                                        T 151
  999 LEAVE = 1                                                          T 152
      GO TO 2000                                                         T 153
C                                                                        T 154
 1000 IF ( L4 .EQ. 0 ) GO TO 2000                                        T 155
C                                                                        T 156
      N1 = NMODES + 1                                                    T 157
      N2 = NMODES + 2                                                    T 158
      DO 1010 I=1,NF                                                     T 159
      H(I,N1) = XF(I)                                                    T 160
 1010 H(I,N2) = YF(I)                                                    T 161
C                                                                        T 162
 2000 RETURN                                                             T 163
      END                                                                T 164
      SUBROUTINE ZEROS ( AM, H, IZ, L3, NF, NF2, NMODES )                U   1
C                                                                        U   2
      DIMENSION  AM(200), H(200,20), IZ(150)                             U   3
C                                                                        U   4
      I1 = NF2 + 1                                                       U   5
      I2 = 0                                                             U   6
      I3 = 201                                                           U   7
      NFK = NF + 1                                                       U   8
      DO 50 I=1,NF                                                       U   9
      I3 = I3 - 1                                                        U  10
      NFK = NFK - 1                                                      U  11
      DO 10 J=1,L3                                                       U  12
      NZ = IABS( IZ(J) )                                                 U  13
      IF ( NZ .NE. NFK ) GO TO 10                                        U  14
C                                                                        U  15
      IF ( IZ(J) ) 1, 2, 2                                               U  16
    1 IF ( I1 .EQ. 0 ) GO TO 999                                         U  17
      I1 = I1 - 1                                                        U  18
      GO TO 30                                                           U  19
    2 I2 = I2 + 1                                                        U  20
      GO TO 30                                                           U  21
C                                                                        U  22
   10 CONTINUE                                                           U  23
C                                                                        U  24
      IF ( I1 .EQ. 0 ) GO TO 999                                         U  25
      I1 = I1 - 1                                                        U  26
      AM(I3) = AM(I1)                                                    U  27
      DO 20 N=1,NMODES                                                   U  28
   20 H(I3,N) = H(I1,N)                                                  U  29
      GO TO 50                                                           U  30
C                                                                        U  31
   30 AM(I3) = 1.0                                                       U  32
      DO 40 N=1,NMODES                                                   U  33
   40 H(I3,N) = 0.0                                                      U  34
C                                                                        U  35
   50 CONTINUE                                                           U  36
C                                                                        U  37
      IF ( I1 .NE. 1 ) GO TO 999                                         U  38
C                                                                        U  39
      I3 = 200 - NF                                                      U  40
      DO 100 I=1,NF                                                      U  41
      I3 = I3 + 1                                                        U  42
      AM(I) = AM(I3)                                                     U  43
      DO 90 N=1,NMODES                                                   U  44
   90 H(I,N) = H(I3,N)                                                   U  45
  100 CONTINUE                                                           U  46
      GO TO 1000                                                         U  47
C                                                                        U  48
  999 WRITE ( 6,101 )  NF2, NF, L3, I1, I2                               U  49
  101 FORMAT (1H1,//," AN ERROR HAS OCCURED IN MODIFYING THE MODES ",    U  50
     1            //,"  TOTAL COORDINATES IN INPUT MODES = ", I4,        U  51
     2            //,"  TOTAL FINAL COORDINATES DESIRED  = ", I4,        U  52
     3            //,"  TOTAL COORDINATES TO BE MODIFIED = ", I4,        U  53
     4            //,"  NUMBER OF INPUT MODE COORDINATES   ", I4,        U  54
     5             /,"                     NOT USED      = ", I4,        U  55
     6            //,"  NUMBER OF COORDINATES SET TO ZERO= ", I4  )      U  56
C                                                                        U  57
      NF = -1                                                            U  58
C                                                                        U  59
 1000 RETURN                                                             U  60
      END                                                                U  61
      SUBROUTINE ARRANG ( A, X, NFS, NSURF, IZ )                         V   1
      DIMENSION  A(200), X(200), NFS(10), IZ(150,10)                     V   2
      NF2 = 0                                                            V   3
      DO 10 IS=1,NSURF                                                   V   4
      NF0 = NF2                                                          V   5
      NF1 = NF2 + 1                                                      V   6
      NF2 = NF2 + NFS(IS)                                                V   7
      DO 10 I=NF1,NF2                                                    V   8
      I2 = IZ(I-NF0,IS)                                                  V   9
   10 X(I) = A(I2)                                                       V  10
      DO 20 I=1,NF2                                                      V  11
   20 A(I) = X(I)                                                        V  12
      RETURN                                                             V  13
      END                                                                V  14
      SUBROUTINE TRNSMD                                                  W   1
C                                                                        W   2
C     SUBROUTINE TO TRANSFORM THE MODES INTO SURFACE SPLINE COEFFICIENTS W   3
C     AND TO REDUCE THE SET TO MINIMUM SIZE FOR FITTING INTO 'ALPVCT'.   W   4
C                                                                        W   5
      COMMON /ALPVCT/ COEF(20,200), XF(200), YF(200), NFS(10), NFS1(10), W   6
     1   GMASS(20,20), NSURF, NMODES, DH, DW1, DW2, SPAN2(10),           W   7
     2   TAN12(10), TAN22(10), CAVG2(10), XR(10), YR(10)                 W   8
C                                                                        W   9
      COMMON /MANE2/  H(200,20), IF(150,12), AMASS(200), NF, NUNIT,      W  10
     1   NMDTP, L1, L2, L3, L4, XMODE, XMASS, BREF, RHO, XIS(2,10),      W  11
     2   XOS(2,10), YCS(2,10), E(53,53), D(200), XFP(200), YFP(1120)     W  12
      COMMON /MATR/ C(103,103)                                           W  13
      IF ( L2  .EQ.  0  ) GO TO 100                                      W  14
      IF ( RHO .EQ. 0.0 ) RHO = 0.0023769                                W  15
C                                                                        W  16
C ***** SEA LEVEL STANDARD DENSITY IS THE DEFAULT VALUE. ****            W  17
C                                                                        W  18
      XMASS = XMASS*432.0/(32.2*RHO*(BREF**3))                           W  19
C                                                                        W  20
C ***** RHO IS SLUGS/FT**3 AND BREF IS INCHES. ****                      W  21
C                                                                        W  22
      DO 10 J=1,NF                                                       W  23
      D(J) = AMASS(J)*XMASS                                              W  24
      DO 10 I=1,NMODES                                                   W  25
   10 H(J,I) = H(J,I)*XMODE                                              W  26
C                                                                        W  27
C     THE GENERALIZED MASSES ARE NOW COMPUTED.                           W  28
C                                                                        W  29
      DO 30 KS=1,NMODES                                                  W  30
      DO 30 KR=1,NMODES                                                  W  31
      GMASS(KR,KS) = 0.0                                                 W  32
      DO 20 I=1,NF                                                       W  33
   20 GMASS(KR,KS) = GMASS(KR,KS) + D(I)*H(I,KR)*H(I,KS)                 W  34
   30 CONTINUE                                                           W  35
C                                                                        W  36
      WRITE (6,40) BREF, RHO                                             W  37
   40 FORMAT (1H1,//,23X," THE GENERALIZED MASSES",//,                   W  38
     1               20X," REFERENCE LENGTH = ",E12.5,//,                W  39
     2               20X," DENSITY          = ",E12.5,//  )              W  40
C                                                                        W  41
      WRITE (6,50) (( GMASS(I,J), I=1,NMODES ), J=1,NMODES )             W  42
   50 FORMAT ( 5E15.7 )                                                  W  43
C                                                                        W  44
C                                                                        W  45
  100 NF2 = 0                                                            W  46
C                                                                        W  47
C     THE STRUCTURAL POINTS ARE TRANSFORMED INTO THE SQUARE PLANE        W  48
C     FOR EACH STRUCTURAL SURFACE.                                       W  49
C                                                                        W  50
      DO 600 IS=1,NSURF                                                  W  51
C                                                                        W  52
      SPAN = YCS(2,IS) - YCS(1,IS)                                       W  53
      TAN1 = ( XOS(1,IS) - XIS(1,IS) )*0.5                               W  54
      TAN2 = ( XOS(2,IS) - XIS(2,IS) )*0.5                               W  55
      CAVG = ( XIS(2,IS) - XIS(1,IS) + XOS(2,IS) - XOS(1,IS) )*0.5       W  56
C                                                                        W  57
      SPAN2(IS) = SPAN                                                   W  58
      TAN12(IS) = TAN1                                                   W  59
      TAN22(IS) = TAN2                                                   W  60
      CAVG2(IS) = CAVG                                                   W  61
      XR(IS)    = ( XIS(1,IS) + XOS(1,IS) )*0.5                          W  62
      YR(IS)    = YCS(1,IS)                                              W  63
C                                                                        W  64
      NF0 = NF2                                                          W  65
      NF1 = NF2 + 1                                                      W  66
      NF2 = NF2 + NFS(IS)                                                W  67
C                                                                        W  68
      DO 520 I=NF1,NF2                                                   W  69
      IF2 = IF(I-NF0,IS)                                                 W  70
      YFP(I) = 2.0*( YF(IF2) - YCS(1,IS) )/SPAN - 1.0                    W  71
      CETA   = CAVG - ( TAN1 - TAN2 )*YFP(I)                             W  72
      XLE    = XR(IS) + YFP(I)*TAN1                                      W  73
  520 XFP(I) = 2.0*( XF(IF2) - XLE )/CETA - 1.0                          W  74
C                                                                        W  75
  600 CONTINUE                                                           W  76
C                                                                        W  77
      WRITE (6,530)                                                      W  78
  530 FORMAT (1H1)                                                       W  79
C                                                                        W  80
      NF2 = 0                                                            W  81
      DO 700 IS=1,NSURF                                                  W  82
      WRITE (6,535) IS                                                   W  83
  535 FORMAT (1H ,//,16X," TRANSFORMED STRUCTURAL POINTS FOR SURFACE ",  W  84
     1  I2 )                                                             W  85
      NF1 = NF2 + 1                                                      W  86
      NF2 = NF2 + NFS(IS)                                                W  87
      DO 550 I=NF1,NF2                                                   W  88
      XF(I) = XFP(I)                                                     W  89
  550 YF(I) = YFP(I)                                                     W  90
C                                                                        W  91
      WRITE (6,560) ( XF(I), YF(I), I=NF1,NF2 )                          W  92
  560 FORMAT (1H ,//,2(10X,"   XF          YF     "),//,(2(8X,2E12.4)) ) W  93
C                                                                        W  94
  700 CONTINUE                                                           W  95
C                                                                        W  96
      IF ( L2 .NE. 0 ) CALL ARRANG ( AMASS, XFP, NFS, NSURF, IF )        W  97
C                                                                        W  98
      NM2 = NMODES                                                       W  99
      IF ( L4 .NE. 0 ) NM2 = NM2 + 2                                     W 100
      DO 710 J=1,NM2                                                     W 101
  710 CALL ARRANG ( H(1,J), XFP, NFS, NSURF, IF )                        W 102
C                                                                        W 103
      IR = 0                                                             W 104
      NF2 = 0                                                            W 105
      DO 750 IS=1,NSURF                                                  W 106
      NF1 = NF2 + 1                                                      W 107
      NF2 = NF2 + NFS(IS)                                                W 108
      NFS1(IS) = NF1                                                     W 109
C                                                                        W 110
      CALL SPLINE( XF(NF1), YF(NF1), NFS(IS), C,D, XFP, YFP, 103, IND )  W 111
C                                                                        W 112
      LFS3 = NFS(IS) + 3                                                 W 113
      DO 740 I=1,LFS3                                                    W 114
      IR = IR + 1                                                        W 115
C                                                                        W 116
      DO 730 J=1,NMODES                                                  W 117
      D(J) = 0.0                                                         W 118
      K = 1                                                              W 119
      DO 730 K2=NF1,NF2                                                  W 120
      D(J) = D(J) + H(K2,J)*C(K,I)                                       W 121
      K = K + 1                                                          W 122
  730 CONTINUE                                                           W 123
C                                                                        W 124
      DO 740 J=1,NMODES                                                  W 125
  740 COEF(J,IR) = D(J)                                                  W 126
      NF3 = IR - LFS3 + 1                                                W 127
C                                                                        W 128
  750 CONTINUE                                                           W 129
      RETURN                                                             W 130
      END                                                                W 131
      OVERLAY(R2T,2,0)                                                   X   1
      PROGRAM    OMANRD                                                  X   2
      CALL MAINRD                                                        X   3
      END                                                                X   4
      SUBROUTINE MAINRD                                                  Y   1
C                                                                        Y   2
C     SUBROUTINE TO CALL APPROPRIATE READ SUBROUTINE ACCORDING TO OP1.   Y   3
C                                                                        Y   4
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,   Y   5
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,    Y   6
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10) Y   7
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH   Y   8
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND     Y   9
      COMMON /TITLE/ VEHC(16), SURF(16)                                  Y  10
      COMMON /COMM/LEAVE,DUM1(11)                                        Y  11
      EQUIVALENCE ( NAME, OREDPR, OGEOTY )                               Y  12
      DATA NAME /6LREADTY/, ENDE /4HEND /                                Y  13
      READ (5,10) ( VEHC(I), I=1,16 )                                    Y  14
   10 FORMAT ( 16A4 )                                                    Y  15
      READ (5,10) ( SURF(I), I=1,16 )                                    Y  16
C                                                                        Y  17
      WRITE (6,20) ( VEHC(I), I=1,16)                                    Y  18
   20 FORMAT (1H1, ///, 4X, 16A4 )                                       Y  19
      WRITE (6,21) ( SURF(I), I=1,16)                                    Y  20
   21 FORMAT ( / , 4X, 16A4, // )                                        Y  21
C                                                                        Y  22
      CALL FREEFD                                                        Y  23
      READ (5,9001) IOP1, IOP2, IOP3, IOP4, IQT, IOPLU                   Y  24
 9001 FORMAT ( 6I10 )                                                    Y  25
C                                                                        Y  26
      IF ( IOP1 .GT. 0 ) GO TO 40                                        Y  27
C                                                                        Y  28
      WRITE (6,35)                                                       Y  29
   35 FORMAT (54H     OPTION 1   THE AERODYNAMIC MATRICES WILL BE        Y  30
     1 ,//,   45H                COMPUTED FOR ALL FREQUENCIES. , //    ) Y  31
      GO TO 50                                                           Y  32
C                                                                        Y  33
   40 WRITE (6,45)  IOP1                                                 Y  34
   45 FORMAT (54H     OPTION 1   THE AERODYNAMIC MATRICES WILL BE        Y  35
     1 ,//,   31H                READ FROM UNIT , I2, // )               Y  36
C                                                                        Y  37
   50 IF ( IOP2 .GE. 0 ) GO TO 60                                        Y  38
C                                                                        Y  39
      WRITE (6,55)                                                       Y  40
   55 FORMAT (54H     OPTION 2   THE AERODYNAMIC PRESSURE DISTRIBUTIONS  Y  41
     1 ,//,   54H                AND INTEGRATED AERODYNAMIC CHARACTER-   Y  42
     2 ,//,   54H                ISTICS WILL BE CALCULATED FOR ALL       Y  43
     3 ,//,   28H                FREQUENCIES. , // )                     Y  44
      GO TO 92                                                           Y  45
C                                                                        Y  46
   60 IF ( IOP2 .NE. 0 ) GO TO 70                                        Y  47
C                                                                        Y  48
      WRITE (6,65)                                                       Y  49
   65 FORMAT (54H     OPTION 2   THE GENERALIZED FORCES WILL BE CALCU-   Y  50
     1 ,//,   54H                LATED FOR ALL FREQUENCIES AS A SET OF   Y  51
     2 ,//,   39H                NMODESXNMODES MATRICES. , // )          Y  52
      GO TO 80                                                           Y  53
C                                                                        Y  54
   70 WRITE (6,75) IOP2                                                  Y  55
   75 FORMAT (54H     OPTION 2   THE GENERALIZED FORCES WILL BE CALCU-   Y  56
     1 ,//,   45H                LATED FOR ALL FREQUENCIES AS  ,I2,      Y  57
     2 ,//,   54H                SETS OF VECTORS WITH NMODES ELEMENTS.   Y  58
     3 ,// )                                                             Y  59
C                                                                        Y  60
   80 IF ( IQT .NE. 0 ) WRITE (6,85) IQT                                 Y  61
   85 FORMAT (54H     IQT        A Q-TERM MATRIX TAPE FOR THE INPUT      Y  62
     1 ,//,   52H                FREQUENCIES WILL BE PRODUCED ON UNIT,   Y  63
     2  I3, // )                                                         Y  64
C                                                                        Y  65
      IF ( IOP3 .NE. 0 ) WRITE (6,90) IOP3                               Y  66
   90 FORMAT (54H     OPTION 3   THE GENERALIZED FORCES WILL BE INTER-   Y  67
     1 ,//,   54H                POLATED AND THE EXPANDED SET WRITTEN    Y  68
     2 ,//,   24H                ON UNIT , I2, // )                      Y  69
C                                                                        Y  70
      IF ( IOP4 .EQ. 0 ) WRITE (6,91)                                    Y  71
   91 FORMAT (54H     OPTION 4   A FLUTTER SOLUTION WILL BE OBTAINED     Y  72
     1        ,// )                                                      Y  73
C                                                                        Y  74
   92 IF ( IOP1 .EQ. 0 ) GO TO 500                                       Y  75
      NUNIT = IABS( IOP1 )                                               Y  76
      REWIND NUNIT                                                       Y  77
C                                                                        Y  78
      WRITE (6,95)                                                       Y  79
   95 FORMAT (54H     OPTIONS 1 AND LU                                   Y  80
     1 ,//,   51H                THE AERODYNAMIC MATRICES ARE IN THE,/ ) Y  81
C                                                                        Y  82
      IF ( IOPLU .NE. 0 ) GO TO 120                                      Y  83
C                                                                        Y  84
      IF ( IOP1 ) 100, 500, 110                                          Y  85
C                                                                        Y  86
  100 WRITE (6,105) NUNIT                                                Y  87
  105 FORMAT (50H                INVERTED FORM ON OUTPUT TAPE UNIT ,     Y  88
     1  I2, // )                                                         Y  89
      GO TO 500                                                          Y  90
C                                                                        Y  91
  110 WRITE (6,115) NUNIT                                                Y  92
  115 FORMAT (49H                INVERTED FORM ON INPUT TAPE UNIT  ,     Y  93
     1  I2, // )                                                         Y  94
      GO TO 500                                                          Y  95
C                                                                        Y  96
  120 IF ( IOP1 ) 130, 500, 140                                          Y  97
C                                                                        Y  98
  130 WRITE (6,135) NUNIT                                                Y  99
  135 FORMAT (52H                UNINVERTED FORM ON OUTPUT TAPE UNIT ,   Y 100
     1  I2, // )                                                         Y 101
      GO TO 500                                                          Y 102
C                                                                        Y 103
  140 WRITE (6,145) NUNIT                                                Y 104
  145 FORMAT (51H                UNINVERTED FORM ON INPUT TAPE UNIT ,    Y 105
     1  I2, // )                                                         Y 106
C                                                                        Y 107
  500 CALL OVERLAY ( OREDPR,2,1 )                                        Y 108
C                                                                        Y 109
      CALL OVERLAY ( OGEOTY,2,2 )                                        Y 110
C                                                                        Y 111
 1000 CONTINUE                                                           Y 112
      RETURN                                                             Y 113
      END                                                                Y 114
      OVERLAY(READTY,2,1)                                                Z   1
      PROGRAM    OREDPR                                                  Z   2
      CALL READPR                                                        Z   3
      END                                                                Z   4
      SUBROUTINE READPR                                                 AA   1
C                                                                       AA   2
C     SUBROUTINE TO READ THE PROBLEM INPUT DATA.                        AA   3
C                                                                       AA   4
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AA   5
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AA   6
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AA   7
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH  AA   8
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AA   9
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AA  10
     2 ETABAR(31,10),XIBAR(15,10), XIS(15,31,10), YBAR(15,10),          AA  11
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AA  12
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AA  13
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AA  14
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AA  15
C                                                                       AA  16
      DIMENSION XLE(63), YLE(63), XTE(63), YTE(63), C(63,63), D(63),    AA  17
     1          GMACH(11,16)                                            AA  18
      COMMON /COMM/LEAVE,DUM1(11)                                       AA  19
      COMMON /GAMA/ GAMMA                                               AA  20
      COMPLEX ALPRS                                                     AA  21
C                                                                       AA  22
      EQUIVALENCE (XLE(1),ETAS(1,1)), (YLE(1),ETAS(1,4)),               AA  23
     1            (XTE(1),ETAS(1,7)), (YTE(1),ETABAR(1,1)),             AA  24
     2            (D(1),ETABAR(1,4)), (GMACH(1,1),ETABAR(1,7)),         AA  25
     3            (C(1,1),XIS(1,1,1))                                   AA  26
C                                                                       AA  27
      CALL FREEFD                                                       AA  28
C                                                                       AA  29
      READ (5,1) NSURF, LS, NALP, NK, NW, IDUMP, IDNWSH, JSUROP         AA  30
      READ (5,3) XMACH, GAMMA, BREF, ( REFREQ(I), I=1,NK )              AA  31
C                                                                       AA  32
      IF ( GAMMA .EQ. 0.0 ) GAMMA = 1.4                                 AA  33
C                                                                       AA  34
    1 FORMAT ( 6I10 )                                                   AA  35
    3 FORMAT ( 6F10.0 )                                                 AA  36
C                                                                       AA  37
      DO 2 I=1,NK                                                       AA  38
    2 RK(I) = REFREQ(I)                                                 AA  39
C                                                                       AA  40
      BETA2 = ABS( 1.0 - XMACH**2 )                                     AA  41
      BETA  = SQRT(BETA2)                                               AA  42
      PI = 3.141593                                                     AA  43
C                                                                       AA  44
      IF ( LS .EQ. 0 ) GO TO 20                                         AA  45
C                                                                       AA  46
      WRITE (6,10)                                                      AA  47
   10 FORMAT (1H1,///,17X,36H ANTI-SYMMETRIC AERODYNAMIC SOLUTION ,// ) AA  48
      GO TO 40                                                          AA  49
   20 WRITE (6,30)                                                      AA  50
   30 FORMAT (1H1,///,17X,36H   SYMMETRIC AERODYNAMIC SOLUTION    ,// ) AA  51
C                                                                       AA  52
      IF ( JSUROP .NE. 0 ) WRITE (6,35)                                 AA  53
   35 FORMAT (17X,36H WITH SUPERSONIC WEIGHTING FUNCTION  ,// )         AA  54
   40 BRINV = 1.0/BREF                                                  AA  55
C                                                                       AA  56
      WRITE (6,50) NSURF, NALP, NW, XMACH, GAMMA, BREF, NK,             AA  57
     1             ( REFREQ(I), I=1,NK )                                AA  58
   50 FORMAT (15X,39H TOTAL NUMBER OF SURFACES            = ,I3   ,// , AA  59
     1        15X,39H TOTAL SETS OF ALPHA VECTORS         = ,I3   ,// , AA  60
     2        15X,39H TOTAL NUMBER OF CONTROL POINTS      = ,I3   ,// , AA  61
     3        15X,39H MACH NUMBER                         = ,E11.4,// , AA  62
     3        15X,39H GAMMA                               = ,E11.4,// , AA  63
     4        15X,39H REFERENCE LENGTH                    = ,E11.4,// , AA  64
     5        15X,39H TOTAL NUMBER OF REDUCED FREQUENCIES = ,I3   ,///, AA  65
     6        15X,39H    THE REDUCED FREQUENCIES ARE              ,// , AA  66
     7                 (3X, 5E15.7 )  )                                 AA  67
C                                                                       AA  68
      DO 500  IS=1,NSURF                                                AA  69
C                                                                       AA  70
      WRITE (6,48) IS                                                   AA  71
   48 FORMAT (1H1,20X,30H DATA FOR LIFTING SURFACE NO.  ,I2,///,        AA  72
     1            22X,30H       GEOMETRIC DATA          )               AA  73
C                                                                       AA  74
      READ (5,1) NC(IS), NS(IS), NJ(IS), NSI(IS), ITRANS(IS), NLE, NTE, AA  75
     1 ICHORD(IS), IXI(IS), LSPAN(IS), LSYM(IS), ISTYPE(IS),            AA  76
     2 ( KSURF(IS,KS), KS=1,NSURF )                                     AA  77
      READ (5,3) ALPO(IS), XV(IS), YV(IS), ZV(IS), THETA(IS)            AA  78
C                                                                       AA  79
      IST = ISTYPE(IS)                                                  AA  80
C                                                                       AA  81
      IF ( ISTYPE(IS) .GT. 1 ) ISTYPE(IS) = ISTYPE(IS) + 1              AA  82
C                                                                       AA  83
      THETA(IS) = THETA(IS)*0.0174533                                   AA  84
C                                                                       AA  85
C     THETA IS CONVERTED TO RADIANS.                                    AA  86
C                                                                       AA  87
      IF ( JSUROP .EQ. 0 ) GO TO 65                                     AA  88
      IF ( ISTYPE(IS) .NE. 1 ) GO TO 65                                 AA  89
C                                                                       AA  90
      WRITE (6,60)                                                      AA  91
   60 FORMAT (5( /,10X,20(2H ") ),//,                                   AA  92
     1  59H   ISTYPE CANNOT BE (1) FOR SUPERSONIC WEIGHTING FUNCTION, , AA  93
     2/,40H   IT MUST BE (2) OR (3) ---- TRY AGAIN.  )                  AA  94
C                                                                       AA  95
      LEAVE = 1                                                         AA  96
      GO TO 2000                                                        AA  97
C                                                                       AA  98
   65 NW2(IS) = NC(IS)*NS(IS)                                           AA  99
      IF ( NJ(IS) .NE. 0 ) GO TO 51                                     AA 100
C                                                                       AA 101
      IF ( XMACH .GE. 1.0 ) GO TO 66                                    AA 102
C                                                                       AA 103
      NJ(IS) = NC(IS)                                                   AA 104
      IF ( IXI(IS) .EQ. 2 )  NJ(IS) = NC(IS) + 1                        AA 105
      IF ( IXI(IS) .EQ. 3 )  NJ(IS) = NC(IS) - 1                        AA 106
      GO TO 51                                                          AA 107
C                                                                       AA 108
   66 NJ(IS) = 2*NC(IS)                                                 AA 109
C                                                                       AA 110
   51 IF ( NSI(IS) .NE. 0 ) GO TO 52                                    AA 111
C                                                                       AA 112
      NSI(IS) = 2*NS(IS) + 1                                            AA 113
      IF ( ISTYPE(IS) .EQ. 3 )  NSI(IS) = NSI(IS) + 1                   AA 114
      IF ( ISTYPE(IS) .EQ. 4 )  NSI(IS) = NS(IS)  + 1                   AA 115
      IF ( ISTYPE(IS) .GT. 1 )  NSI(IS) = 2*NSI(IS)                     AA 116
C                                                                       AA 117
   52 READ (5,3) ( XLE(I), YLE(I), I=1,NLE )                            AA 118
      READ (5,3) ( XTE(I), YTE(I), I=1,NTE )                            AA 119
C                                                                       AA 120
      WRITE (6,216) ( XLE(I), YLE(I), I=1,NLE )                         AA 121
      WRITE (6,217) ( XTE(I), YTE(I), I=1,NTE )                         AA 122
C                                                                       AA 123
      CALL BREAK ( BRPT(1,1,IS), NBRPT(IS), XLE, YLE, XTE, YTE,         AA 124
     1             NLE, NTE, LEAVE )                                    AA 125
C                                                                       AA 126
      IF ( LEAVE .NE. 0 ) GO TO 2000                                    AA 127
C                                                                       AA 128
      BO(IS) = 0.5*( BRPT(1,2,IS) - BRPT(1,1,IS) )                      AA 129
      I = NBRPT(IS)                                                     AA 130
      SO(IS) = BRPT(2,I,IS) - BRPT(2,1,IS)                              AA 131
C                                                                       AA 132
      NB2      = NBRPT(IS)                                              AA 133
      NEND(IS) = NBRPT(IS)/2 - 1                                        AA 134
      BOINV(IS)= 1.0/BO(IS)                                             AA 135
C                                                                       AA 136
      BO2 = BO(IS) + BRPT(1,1,IS)                                       AA 137
      Y   = BRPT(2,1,IS)                                                AA 138
      DO 70 IX2=1,NB2                                                   AA 139
      BRPT(1,IX2,IS) = BRPT(1,IX2,IS) - BO2                             AA 140
   70 BRPT(2,IX2,IS) = BRPT(2,IX2,IS) - Y                               AA 141
C                                                                       AA 142
      XV(IS) = ( XV(IS) + BO(IS) )*BRINV                                AA 143
      YV(IS) = YV(IS)*BRINV                                             AA 144
      ZV(IS) = ZV(IS)*BRINV                                             AA 145
C                                                                       AA 146
C     CALCULATION OF THE ASPECT RATIO AND AREA OF THE SEMI-SPAN.        AA 147
C                                                                       AA 148
      AREA2 = 0.0                                                       AA 149
      I = 1                                                             AA 150
   80 I = I + 2                                                         AA 151
      AREA2 = AREA2 + ( BRPT(2,I,IS) - BRPT(2,I-2,IS) )                 AA 152
     1           *0.5*( BRPT(1,I-1,IS) - BRPT(1,I-2,IS)                 AA 153
     2                + BRPT(1,I+1,IS) - BRPT(1,I,IS) )                 AA 154
C                                                                       AA 155
      IF ( I .LT. NB2-2 ) GO TO 80                                      AA 156
C                                                                       AA 157
      AR(IS) = 2.0*( SO(IS)**2 )/AREA2                                  AA 158
      AREA(IS) = AREA2                                                  AA 159
C                                                                       AA 160
      IF ( DUM1(11) .EQ. 0.0 ) GO TO 89                                 AA 161
      READ (5,1) NST(IS)                                                AA 162
      WRITE (6,85) IS, NST(IS)                                          AA 163
   85 FORMAT (//,"  AERO SURFACE ", I2," WILL USE SLOPES AND ",         AA 164
     1        //,"  DEFLECTIONS FROM STRUCTURAL SURFACE ",I2  )         AA 165
C                                                                       AA 166
   89 IF ( ITRANS(IS) .EQ. 0 ) GO TO 200                                AA 167
C                                                                       AA 168
C     THE MACH NUMBER DISTRIBUTION IS NOW READ.                         AA 169
C                                                                       AA 170
      NCP1 = NC(IS) + 1                                                 AA 171
      NSP1 = NS(IS) + 1                                                 AA 172
C                                                                       AA 173
      IF ( ITRANS(IS) .LT. 0 ) GO TO 100                                AA 174
C                                                                       AA 175
      READ (5,3) ( GMACH(I,1), I=1,NCP1 )                               AA 176
C                                                                       AA 177
      DO 90 J=2,NSP1                                                    AA 178
      DO 90 I=1,NCP1                                                    AA 179
   90 GMACH(I,J) = GMACH(I,1)                                           AA 180
      GO TO 110                                                         AA 181
C                                                                       AA 182
  100 READ (5,3) ( ( GMACH(I,J), I=1,NCP1 ), J=1,NSP1 )                 AA 183
C                                                                       AA 184
C                                                                       AA 185
  110 DELT = 2.0/NC(IS)                                                 AA 186
      XTE(1) = -1.0                                                     AA 187
      NCP = NC(IS)                                                      AA 188
      NSP = NS(IS)                                                      AA 189
      DO 112 I=2,NCP                                                    AA 190
  112 XTE(I) = XTE(I-1) + DELT                                          AA 191
      XTE(NCP1) = 1.0                                                   AA 192
C                                                                       AA 193
      DELT = 2.0/NS(IS)                                                 AA 194
      YTE(1) = -1.0                                                     AA 195
      DO 114 J=2,NSP                                                    AA 196
  114 YTE(J) = YTE(J-1) + DELT                                          AA 197
      YTE(NSP1) = 1.0                                                   AA 198
C                                                                       AA 199
      K = 0                                                             AA 200
      DO 120 J=1,NSP1                                                   AA 201
      DO 120 I=1,NCP1                                                   AA 202
      K = K + 1                                                         AA 203
      XLE(K) = XTE(I)                                                   AA 204
  120 YLE(K) = YTE(J)                                                   AA 205
C                                                                       AA 206
      N2 = K                                                            AA 207
C                                                                       AA 208
      CALL SPLINE ( XLE, YLE, N2, C, D, IA, IB, 63, LEAVE )             AA 209
      IF ( LEAVE .NE. 0 ) GO TO 2000                                    AA 210
C                                                                       AA 211
      N3 = N2 + 3                                                       AA 212
      DO 140 K=1,N3                                                     AA 213
      D(1) = 0.0                                                        AA 214
      L = 0                                                             AA 215
      DO 130 J=1,NSP1                                                   AA 216
      DO 130 I=1,NCP1                                                   AA 217
      L = L + 1                                                         AA 218
      BMACH(L,IS) = GMACH(I,J)                                          AA 219
  130 D(1) = D(1) + C(L,K)*GMACH(I,J)                                   AA 220
  140 C(1,K) = D(1)                                                     AA 221
C                                                                       AA 222
      DELT = PI/(2.0*NCP)                                               AA 223
      DO 145 I=1,NCP                                                    AA 224
  145 XTE(I) = -COS( DELT*(2*I-1) )                                     AA 225
      DELT = PI/(2.0*NSP)                                               AA 226
      DO 150 J=1,NSP                                                    AA 227
  150 YTE(J) = -COS( DELT*(2*J-1) )                                     AA 228
C                                                                       AA 229
      DO 160 J=1,NSP                                                    AA 230
      DO 160 I=1,NCP                                                    AA 231
C                                                                       AA 232
  160 CALL MAGN ( XTE(I), YTE(J), N2, 1, XLE, YLE, GMACH(I,J), D, C, 63)AA 233
C                                                                       AA 234
      DO 165 I=1,NCP                                                    AA 235
      XBAR(1,I) = 1.0                                                   AA 236
      XBAR(2,I) = XTE(I)                                                AA 237
      DO 165 K=3,NCP                                                    AA 238
  165 XBAR(K,I) = 2*XTE(I)*XBAR(K-1,I) - XBAR(K-2,I)                    AA 239
C                                                                       AA 240
      DO 170 J=1,NSP                                                    AA 241
      YBAR(1,J) = 1.0                                                   AA 242
      YBAR(2,J) = YTE(J)                                                AA 243
      DO 170 K=3,NSP                                                    AA 244
  170 YBAR(K,J) = 2*YTE(J)*YBAR(K-1,J) - YBAR(K-2,J)                    AA 245
C                                                                       AA 246
      DELT = 2.0/NCP                                                    AA 247
      DO 185 J=1,NSP                                                    AA 248
      DO 175 K=1,NCP                                                    AA 249
      D(K) = 0.0                                                        AA 250
      DO 175 I=1,NCP                                                    AA 251
  175 D(K) = D(K) + XBAR(K,I)*GMACH(I,J)                                AA 252
      DO 180 K=2,NCP                                                    AA 253
  180 GMACH(K,J) = D(K)*DELT                                            AA 254
  185 GMACH(1,J) = D(1)/NCP                                             AA 255
C                                                                       AA 256
      DELT = 2.0/NSP                                                    AA 257
      DO 198 I=1,NCP                                                    AA 258
      DO 190 K=1,NSP                                                    AA 259
      D(K) = 0.0                                                        AA 260
      DO 190 J=1,NSP                                                    AA 261
  190 D(K) = D(K) + YBAR(K,J)*GMACH(I,J)                                AA 262
      DO 195 K=2,NSP                                                    AA 263
  195 GMACH(I,K) = D(K)*DELT                                            AA 264
  198 GMACH(I,1) = D(1)/NSP                                             AA 265
C                                                                       AA 266
  200 WRITE (6,210) NC(IS), NS(IS), NJ(IS), NSI(IS), SO(IS), BO(IS),    AA 267
     1 AREA(IS), AR(IS)                                                 AA 268
C                                                                       AA 269
  210 FORMAT( //, 22X,30H      AERODYNAMIC DATA         , //, 5X,       AA 270
     1  "   NC = ",I2,"   NS = ",I2,"   NJ = ",I2,"   NSI = ",I2,"   SO AA 271
     2= ",E11.4,//,5X,"   BO = ",E11.4,   "  AREA = ",E11.4,"    AR = ",AA 272
     3  E11.4    )                                                      AA 273
C                                                                       AA 274
      WRITE (6,215) XV(IS), YV(IS), ZV(IS), THETA(IS), ICHORD(IS),      AA 275
     1 IXI(IS),IST,        LSYM(IS), LSPAN(IS)                          AA 276
C                                                                       AA 277
  215 FORMAT (/,5X,"   XV = ",E11.4,"    YV = ",E11.4,"    ZV = ",E11.4,AA 278
     1 //,      5X,"THETA = ",E11.4," ICORD = ",I2,9X,"   IXI = ",I2,9X,AA 279
     2 //,      5X,"ISTYP = ",I2,9X,"  LSYM = ",I2,9X," LSPAN = ",I2 )  AA 280
C                                                                       AA 281
  216 FORMAT (//,24X," LEADING EDGE POINTS", //,                        AA 282
     1           24X,"XLE               YLE",//, (20X,E12.5,6X,E12.5) ) AA 283
  217 FORMAT (//,24X," TRAILING EDGE POINTS",//,                        AA 284
     1           24X,"XTE               YTE",//, (20X,E12.5,6X,E12.5) ) AA 285
C                                                                       AA 286
      WRITE (6,218) IS                                                  AA 287
  218 FORMAT (1H1,20X,30H DATA FOR LIFTING SURFACE NO.  ,I2,/ )         AA 288
C                                                                       AA 289
      IF ( ITRANS(IS) .EQ. 0 ) GO TO 400                                AA 290
C                                                                       AA 291
      WRITE (6,220) ( YLE(J), J=1,N2,NCP1 )                             AA 292
  220 FORMAT (//,22X," MACH NUMBER DISTRIBUTION",//,9X,"YBAR",/,        AA 293
     1  (7X,16F7.3),/,"  XBAR" )                                        AA 294
      WRITE (6,225)                                                     AA 295
  225 FORMAT ( "  XBAR" )                                               AA 296
C                                                                       AA 297
      DO 230 I=1,NCP1                                                   AA 298
  230 WRITE (6,240) XLE(I), ( BMACH(J,IS), J=I,N2,NCP1 )                AA 299
  240 FORMAT ( (17F7.3,/) )                                             AA 300
C                                                                       AA 301
      K = 0                                                             AA 302
      DO 250 I=1,NCP                                                    AA 303
      DO 250 J=1,NSP                                                    AA 304
      K = K + 1                                                         AA 305
  250 BMACH(K,IS) = GMACH(I,J)                                          AA 306
C                                                                       AA 307
      WRITE (6,260) ( YLE(J), J=1,N2,NCP1 )                             AA 308
  260 FORMAT (//,15X," RECALCULATED MACH NUMBER DISTRIBUTION ",//,      AA 309
     1  9X, "YBAR",/, ( 7X,16F7.3 ) )                                   AA 310
      WRITE (6,225)                                                     AA 311
C                                                                       AA 312
      DO 280 I=1,NCP1                                                   AA 313
      K = 0                                                             AA 314
      DO 270 J=1,N2,NCP1                                                AA 315
      K = K + 1                                                         AA 316
  270 CALL CALCM ( XLE(I), YLE(J), NCP, NSP, BMACH(1,IS),               AA 317
     1             GMACH(K,1), IA, IB )                                 AA 318
C                                                                       AA 319
  280 WRITE (6,240) XLE(I), ( GMACH(K,1), K=1,NSP1 )                    AA 320
C                                                                       AA 321
  400 CALL PROPT ( KSURF, NSURF, IS, ITRANS(IS), LEAVE )                AA 322
C                                                                       AA 323
  500 CONTINUE                                                          AA 324
      LEAVE = 0                                                         AA 325
C                                                                       AA 326
 2000 RETURN                                                            AA 327
      END                                                               AA 328
      SUBROUTINE PROPT ( KSURF, NSURF, IS, ITRANS, LEAVE )              AB   1
C                                                                       AB   2
C     SUBROUTINE TO PRINT THE AERODYNAMIC MATRIX OPTION DATA.           AB   3
C                                                                       AB   4
      DIMENSION KSURF(10,10)                                            AB   5
C                                                                       AB   6
      WRITE (6,10) IS, ITRANS                                           AB   7
   10 FORMAT (///,23X," AERODYNAMIC MATRIX DATA ",//,                   AB   8
     1           ,23X,"     ITRANS(",I2,") = ",I2     )                 AB   9
C                                                                       AB  10
      WRITE (6,15) IS, IS, KSURF(IS,IS)                                 AB  11
   15 FORMAT (//,"        KSURF(",I2,",",I2,") = ",I3  )                AB  12
C                                                                       AB  13
      IF ( KSURF(IS,IS) ) 20, 30, 40                                    AB  14
C                                                                       AB  15
   20 WRITE (6,25) IS                                                   AB  16
   25 FORMAT (/, "     SURFACE ",I2," IS TRANSONIC WITH A SHOCK AT THE",AB  17
     1        /, "     LEADING EDGE AND ALL SUBSONIC FLOW. " )          AB  18
      GO TO 50                                                          AB  19
C                                                                       AB  20
   30 WRITE (6,35) IS                                                   AB  21
   35 FORMAT (/, "     SURFACE ",I2," IS NOT A TRANSONIC SURFACE." )    AB  22
      GO TO 50                                                          AB  23
C                                                                       AB  24
   40 WRITE (6,45) IS                                                   AB  25
   45 FORMAT (/, "     SURFACE ",I2," IS TRANSONIC WITH A SHOCK AT THE",AB  26
     1        /, "     TRAILING EDGE AND ALL SUPERSONIC OR SUBSONIC TO",AB  27
     2        /, "     SUPERSONIC ACCELERATING FLOW. " )                AB  28
C                                                                       AB  29
   50 IF ( NSURF .EQ. 1 ) GO TO 200                                     AB  30
      DO 100 KS=1,NSURF                                                 AB  31
      IF ( IS .EQ. KS ) GO TO 100                                       AB  32
      WRITE (6,15) IS, KS, KSURF(IS,KS)                                 AB  33
      IF ( KSURF(IS,KS) ) 60, 70, 80                                    AB  34
C                                                                       AB  35
   60 WRITE (6,65) KS, IS                                               AB  36
   65 FORMAT (/, "     SURFACE ",I2," WILL NOT HAVE ANY INTERFERENCE ", AB  37
     1        /, "     EFFECTS ON SURFACE ",I2,"." )                    AB  38
      GO TO 100                                                         AB  39
C                                                                       AB  40
   70 WRITE (6,75) KS, IS                                               AB  41
   75 FORMAT (/, "     SURFACE ",I2," WILL HAVE INTERFERENCE EFFECTS ", AB  42
     1        /, "     ON SURFACE ",I2,", BUT CORRECTION TERMS WILL ",  AB  43
     2        /, "     NOT BE CALCULATED." )                            AB  44
      GO TO 100                                                         AB  45
C                                                                       AB  46
   80 WRITE (6,85) KS, IS                                               AB  47
   85 FORMAT (/, "     SURFACE ",I2," WILL HAVE INTERFERENCE EFFECTS ", AB  48
     1        /, "     ON SURFACE ",I2,", AND CORRECTION TERMS WILL ",  AB  49
     2        /, "     BE CALCULATED." )                                AB  50
C                                                                       AB  51
  100 CONTINUE                                                          AB  52
C                                                                       AB  53
  200 RETURN                                                            AB  54
      END                                                               AB  55
      SUBROUTINE BREAK( BRPT, NBRPT, XLE, YLE, XTE, YTE, NLE, NTE, IND )AC   1
C                                                                       AC   2
C     SUBROUTINE TO CONVERT LEADING AND TRAILING EDGE BREAKPOINT        AC   3
C     ARRAYS INTO BREAKCHORD ARRAYS.                                    AC   4
C                                                                       AC   5
      DIMENSION BRPT(2,40), XLE(20), YLE(20), XTE(20), YTE(20)          AC   6
C                                                                       AC   7
      IF ( YLE(NLE) .EQ. YTE(NTE) ) GO TO 70                            AC   8
C                                                                       AC   9
      WRITE (6,65) YLE(NLE), YTE(NTE)                                   AC  10
   65 FORMAT (1H1," THE LEADING AND TRAILING EDGE END COORDINATES", //, AC  11
     1            " DO NOT MATCH, YLE(NLE)=",E14.7,"  YTE(NTE)=",E14.7 )AC  12
      GO TO 999                                                         AC  13
C                                                                       AC  14
   70 IF ( NLE .LT. 21 .AND. NTE .LT. 21 ) GO TO 80                     AC  15
      WRITE (6,75) NLE, NTE                                             AC  16
   75 FORMAT (1H1," THE PLANFORM BOUNDARY POINTS EXCEED 20 ", //,       AC  17
     1            " NLE = ", I10,"        NTE = ", I10 )                AC  18
      GO TO 999                                                         AC  19
C                                                                       AC  20
   80 BRPT(1,1) = XLE(1)                                                AC  21
      BRPT(2,1) = YLE(1)                                                AC  22
      BRPT(1,2) = XTE(1)                                                AC  23
      BRPT(2,2) = YTE(1)                                                AC  24
      L = 2                                                             AC  25
      I = 2                                                             AC  26
      K = 3                                                             AC  27
C                                                                       AC  28
   85 IF ( I .GT. NLE .OR. L .GT. NTE ) GO TO 110                       AC  29
      IF ( YLE(I) - YTE(L) ) 87,90,100                                  AC  30
C                                                                       AC  31
   87 BRPT(1,K) = XLE(I)                                                AC  32
      BRPT(2,K) = YLE(I)                                                AC  33
      BRPT(1,K+1) = XTE(L-1) + (XTE(L)-XTE(L-1))*(YLE(I)-YTE(L-1))      AC  34
     1                                          /(YTE(L)-YTE(L-1))      AC  35
      BRPT(2,K+1) = YLE(I)                                              AC  36
      I = I+1                                                           AC  37
      K = K+2                                                           AC  38
      GO TO 85                                                          AC  39
C                                                                       AC  40
   90 BRPT(1,K) = XLE(I)                                                AC  41
      BRPT(2,K) = YLE(I)                                                AC  42
      BRPT(1,K+1) = XTE(L)                                              AC  43
      BRPT(2,K+1) = YTE(L)                                              AC  44
      I = I+1                                                           AC  45
      L = L+1                                                           AC  46
      K = K+2                                                           AC  47
      GO TO 85                                                          AC  48
C                                                                       AC  49
  100 BRPT(1,K) = XLE(I-1)+(XLE(I)-XLE(I-1))*(YTE(L)-YLE(I-1))          AC  50
     1                                      /(YLE(I)-YLE(I-1))          AC  51
      BRPT(2,K) = YTE(L)                                                AC  52
      BRPT(1,K+1) = XTE(L)                                              AC  53
      BRPT(2,K+1) = YTE(L)                                              AC  54
      L = L+1                                                           AC  55
      K = K+2                                                           AC  56
      GO TO 85                                                          AC  57
C                                                                       AC  58
  110 NBRPT = K-1                                                       AC  59
      IND = 0                                                           AC  60
      GO TO 1000                                                        AC  61
C                                                                       AC  62
  999 IND = 1                                                           AC  63
 1000 RETURN                                                            AC  64
      END                                                               AC  65
      OVERLAY(READTY,2,2)                                               AD   1
      PROGRAM    OGEOTY                                                 AD   2
      CALL GEOMTY                                                       AD   3
      END                                                               AD   4
      SUBROUTINE GEOMTY                                                 AE   1
C                                                                       AE   2
C     SUBROUTINE TO COMPUTE THE SUBSONIC OR SUPERSONIC GEOMETRY DATA    AE   3
C     ACCORDING TO THE VALUE OF QMACH(1).                               AE   4
C                                                                       AE   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AE   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AE   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AE   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH  AE   9
C                                                                       AE  10
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AE  11
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AE  12
     2 ETABAR(31,10),XIBAR(15,10), XIS(15,31,10), YBAR(15,10),          AE  13
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AE  14
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AE  15
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AE  16
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AE  17
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND    AE  18
      COMMON /COMM/ LEAVE, DUM1(11)                                     AE  19
C                                                                       AE  20
      DO 1000 IS=1,NSURF                                                AE  21
C                                                                       AE  22
      J1 = 1                                                            AE  23
      MBAR = NC(IS)                                                     AE  24
      I  = IXI(IS)                                                      AE  25
      GO TO ( 10, 20, 30, 50 ),I                                        AE  26
C                                                                       AE  27
   10 B1 = PI/(2*MBAR+1)                                                AE  28
C     REGULAR HSU POINTS ARE COMPUTED.                                  AE  29
      JJ = 0                                                            AE  30
      GO TO 40                                                          AE  31
C                                                                       AE  32
   20 B1 = PI/(2*MBAR+2)                                                AE  33
      JJ = 0                                                            AE  34
C     TSCHEBYCHEV ROOTS CORRESPONDING TO FIRST KIND POLY. USED.         AE  35
      GO TO 40                                                          AE  36
C                                                                       AE  37
   30 B1 = PI/(2*MBAR-1)                                                AE  38
      XBAR(1,IS) = -0.999                                               AE  39
      JJ = 2                                                            AE  40
C     HSU POINTS USED WITH A LEADING EDGE POINT.                        AE  41
      J1 = 2                                                            AE  42
C                                                                       AE  43
   40 DO 45 JI=J1,MBAR                                                  AE  44
      JP = 2*JI - JJ                                                    AE  45
   45 XBAR(JI,IS) = -COS(JP*B1)                                         AE  46
      GO TO 60                                                          AE  47
C                                                                       AE  48
   50 READ (5,1) ( XBAR(JI,IS), JI=1,MBAR )                             AE  49
    1 FORMAT ( 6F10.0 )                                                 AE  50
C                                                                       AE  51
   60 NR = IABS(NS(IS))                                                 AE  52
      B1 = PI/(2*NR+1)                                                  AE  53
      IF ( ISTYPE(IS) .GT. 2 ) B1 = PI/(NR+1)                           AE  54
      COSTH = COS(THETA(IS))*BRINV                                      AE  55
      SINTH = SIN(THETA(IS))*BRINV                                      AE  56
      DO 70 JR=1,NR                                                     AE  57
      YBAR(JR,IS) = COS(JR*B1)                                          AE  58
      Y = YBAR(JR,IS)*SO(IS)                                            AE  59
      IF ( ISTYPE(IS) .GT. 2 ) Y = ( Y + SO(IS) )*0.5                   AE  60
      YS(JR,IS) = Y*COSTH + YV(IS)                                      AE  61
      SIGY(JR,IS) = THETA(IS)                                           AE  62
      ZY(JR,IS) = Y*SINTH + ZV(IS)                                      AE  63
      CALL XMBY ( XM, BY, Y, BRPT(1,1,IS), NEND(IS) )                   AE  64
      BYBO (JR,IS) = BY*BRINV                                           AE  65
      DO 70 JI=1,MBAR                                                   AE  66
   70 XS(JI,JR,IS) = ( BY*XBAR(JI,IS) + XM )*BRINV + XV(IS)             AE  67
C                                                                       AE  68
C                                                                       AE  69
      J = NJ(IS)                                                        AE  70
      I = IXI(IS)                                                       AE  71
      GO TO ( 72, 74, 72, 85 ), I                                       AE  72
C                                                                       AE  73
   72 B1 = PI/(2*J+1)                                                   AE  74
      GO TO 80                                                          AE  75
C                                                                       AE  76
   74 B1 = PI/(2*J)                                                     AE  77
C                                                                       AE  78
   80 DO 82 J1=1,J                                                      AE  79
   82 XIBAR(J1,IS) = -COS((2*J1-1)*B1)                                  AE  80
      GO TO 86                                                          AE  81
C                                                                       AE  82
   85 READ (5,1) ( XIBAR(J1,IS), J1=1,J )                               AE  83
C                                                                       AE  84
   86 IF ( ISTYPE(IS) .GT. 2 ) GO TO 130                                AE  85
C                                                                       AE  86
C                                                                       AE  87
      NS2 = NSI(IS)                                                     AE  88
      B1  = PI/(2*NS2)                                                  AE  89
      DO 90 JS=1,NS2                                                    AE  90
      ETABAR(JS,IS) = -COS( (2*JS-1)*B1 )                               AE  91
      ETA = ETABAR(JS,IS)*SO(IS)                                        AE  92
      SIGETA(JS,IS) = THETA(IS)                                         AE  93
      IF ( ETA .LT. 0 ) SIGETA(JS,IS) = -THETA(IS)                      AE  94
      ETAS(JS,IS) = ETA*BRINV*COS(SIGETA(JS,IS))                        AE  95
      ZETA(JS,IS) = ETA*BRINV*SIN(SIGETA(JS,IS)) + ZV(IS)               AE  96
      CALL XMBY ( XM, BY, ETA, BRPT(1,1,IS), NEND(IS) )                 AE  97
      BETABO(JS,IS) = BY*BRINV                                          AE  98
      XISLTE(1,JS,IS) = -BETABO(JS,IS) + XM*BRINV + XV(IS)              AE  99
      XISLTE(2,JS,IS) =  BETABO(JS,IS) + XM*BRINV + XV(IS)              AE 100
      DO 90 JJ=1,J                                                      AE 101
   90 XIS(JJ,JS,IS) = ( BY*XIBAR(JJ,IS) + XM )*BRINV + XV(IS)           AE 102
      GO TO 200                                                         AE 103
C                                                                       AE 104
C                                                                       AE 105
  130 IF ( ISTYPE(IS) .EQ. 4 ) GO TO 160                                AE 106
C                                                                       AE 107
      NS2 = NSI(IS)/2                                                   AE 108
      B1  = PI/(2*NS2)                                                  AE 109
      DO 140 JS=1,NS2                                                   AE 110
      ETABAR(JS,IS) = -COS( (2*JS-1)*B1 )                               AE 111
      ETABAR(JS+NS2,IS) = ETABAR(JS,IS)                                 AE 112
      ETA = ( ETABAR(JS,IS) + 1.0 )*SO(IS)*0.5                          AE 113
      SIGETA(JS,IS) = THETA(IS)                                         AE 114
      SIGETA(JS+NS2,IS) = -THETA(IS)                                    AE 115
      ETAS(JS,IS) = ETA*BRINV*COS(SIGETA(JS,IS)) + YV(IS)               AE 116
      ETAS(JS+NS2,IS) = -ETAS(JS,IS)                                    AE 117
      ZETA(JS,IS) = ETA*BRINV*SIN(SIGETA(JS,IS)) + ZV(IS)               AE 118
      ZETA(JS+NS2,IS) = ZETA(JS,IS)                                     AE 119
C                                                                       AE 120
      CALL XMBY ( XM, BY, ETA, BRPT(1,1,IS), NEND(IS) )                 AE 121
      BETABO (JS,IS) = BY*BRINV                                         AE 122
      BETABO (JS+NS2,IS) = BETABO(JS,IS)                                AE 123
      XISLTE (1,JS,IS) = -BETABO(JS,IS) + XM*BRINV + XV(IS)             AE 124
      XISLTE (2,JS,IS) =  BETABO(JS,IS) + XM*BRINV + XV(IS)             AE 125
      XISLTE (1,JS+NS2,IS)= XISLTE(1,JS,IS)                             AE 126
      XISLTE (2,JS+NS2,IS)= XISLTE(2,JS,IS)                             AE 127
C                                                                       AE 128
      DO 140 JJ=1,J                                                     AE 129
      XIS(JJ,JS,IS) = ( BY*XIBAR(JJ,IS) + XM )*BRINV + XV(IS)           AE 130
  140 XIS(JJ,JS+NS2,IS) = XIS(JJ,JS,IS)                                 AE 131
C                                                                       AE 132
      GO TO 200                                                         AE 133
C                                                                       AE 134
  160 NS2 =  NSI(IS)                                                    AE 135
      B1  = PI/(2*NS2)                                                  AE 136
      DO 170 JS=1,NS2                                                   AE 137
      ETABAR(JS,IS) = -COS( (2*JS-1)*B1 )                               AE 138
      ETA = ( ETABAR(JS,IS) + 1.0 )*SO(IS)*0.5                          AE 139
      SIGETA(JS,IS) = THETA(IS)                                         AE 140
      ETAS(JS,IS) = ETA*BRINV*COS(SIGETA(JS,IS)) + YV(IS)               AE 141
      ZETA(JS,IS) = ETA*BRINV*SIN(SIGETA(JS,IS)) + ZV(IS)               AE 142
      CALL XMBY ( XM, BY, ETA, BRPT(1,1,IS), NEND(IS) )                 AE 143
      BETABO(JS,IS) = BY*BRINV                                          AE 144
      XISLTE(1,JS,IS) = -BETABO(JS,IS) + XM*BRINV + XV(IS)              AE 145
      XISLTE(2,JS,IS) =  BETABO(JS,IS) + XM*BRINV + XV(IS)              AE 146
C                                                                       AE 147
      DO 170 JJ=1,J                                                     AE 148
  170 XIS(JJ,JS,IS) = ( BY*XIBAR(JJ,IS) + XM )*BRINV + XV(IS)           AE 149
C                                                                       AE 150
C                                                                       AE 151
  200 MBAR = NC(IS)                                                     AE 152
      NR   = IABS(NS(IS))                                               AE 153
C                                                                       AE 154
C                                                                       AE 155
      J = NJ (IS)                                                       AE 156
      NS2= IABS(NSI(IS))                                                AE 157
C                                                                       AE 158
  300 IF ( IDUMP .EQ. 0 ) GO TO 1000                                    AE 159
C                                                                       AE 160
      WRITE (6,350) IS                                                  AE 161
  350 FORMAT (1H1,17X,37H DOWNWASH AND CONTROL POINT LOCATIONS          AE 162
     1   ,//,     17X,27H   FOR LIFTING SURFACE NO. ,I2,// )            AE 163
C                                                                       AE 164
      WRITE (6,360)                                                     AE 165
  360 FORMAT (1H ,19X," THE DOWNWASH CHORD LOCATIONS ",//,              AE 166
     1   3(25H   YBAR(I)       YS(I)   ), / )                           AE 167
      WRITE (6,380) ( YBAR(I,IS), YS(I,IS), I=1,NR )                    AE 168
  380 FORMAT (3(1X,2E12.4) )                                            AE 169
C                                                                       AE 170
      WRITE (6,382)                                                     AE 171
  382 FORMAT( /, 3(25H   SIGY(I)       ZY(I)   ), / )                   AE 172
      WRITE (6,380) ( SIGY(I,IS), ZY(I,IS), I=1,NR )                    AE 173
C                                                                       AE 174
      WRITE (6,390)                                                     AE 175
  390 FORMAT (1H ,//,17X," THE CHORDWISE DOWNWASH LOCATIONS",/ )        AE 176
      DO 399 JI=1,MBAR                                                  AE 177
      WRITE (6,396) JI, XBAR(JI,IS)                                     AE 178
  396 FORMAT ( /," XBAR(",I2,")=",E12.4 )                               AE 179
      WRITE (6,397) JI                                                  AE 180
  397 FORMAT (" THE VALUES OF XS(JI,JR) FOR JI = ", I2, " ARE ", / )    AE 181
      WRITE (6,398) ( XS(JI,JR,IS), JR=1,NR )                           AE 182
  398 FORMAT (1X, 6E12.4 )                                              AE 183
C                                                                       AE 184
  399 CONTINUE                                                          AE 185
C                                                                       AE 186
                                                                        AE 187
      WRITE (6,400)                                                     AE 188
  400 FORMAT (1H1,//,18X," THE INTEGRATION CHORD LOCATIONS ", //,       AE 189
     1  3(25H  ETABAR(I)     ETAS(I)  ),/ )                             AE 190
      WRITE (6,380) ( ETABAR(I,IS), ETAS(I,IS), I=1,NS2 )               AE 191
C                                                                       AE 192
      WRITE (6,402)                                                     AE 193
  402 FORMAT( /, 3( 25H  SIGETA(I)     ZETA(I)  ), / )                  AE 194
      WRITE (6,380) ( SIGETA(I,IS), ZETA(I,IS), I=1,NS2 )               AE 195
C                                                                       AE 196
      WRITE (6,410)                                                     AE 197
  410 FORMAT (1H ,//,16X," THE CHORDWISE INTEGRATION LOCATIONS", / )    AE 198
C                                                                       AE 199
      DO 420 JJ=1,J                                                     AE 200
      WRITE (6,416) JJ, XIBAR(JJ,IS)                                    AE 201
  416 FORMAT ( /, " XIBAR(",I2,")=", E11.4 )                            AE 202
      WRITE (6,417) JJ                                                  AE 203
  417 FORMAT (" THE VALUES OF XIS(JJ,JS) FOR JJ=",I2," ARE " )          AE 204
      WRITE (6,398) ( XIS(JJ,JS,IS), JS=1,NS2 )                         AE 205
  420 CONTINUE                                                          AE 206
C                                                                       AE 207
C                                                                       AE 208
 1000 CONTINUE                                                          AE 209
C                                                                       AE 210
 2000 LEAVE = 0                                                         AE 211
      RETURN                                                            AE 212
      END                                                               AE 213
      OVERLAY(R2T,3,0)                                                  AF   1
      PROGRAM    OMANAE                                                 AF   2
      CALL MAINAE                                                       AF   3
      END                                                               AF   4
      SUBROUTINE MAINAE                                                 AG   1
C                                                                       AG   2
C     SUBROUTINE TO CALL THE SUBROUTINES FOR COMPUTING THE SUBSONIC     AG   3
C     OR SUPERSONIC, STEADY OR UNSTEADY AERODYNAMIC MATRICES.           AG   4
C                                                                       AG   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AG   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AG   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AG   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH  AG   9
C                                                                       AG  10
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND    AG  11
      COMMON /COMM/ LEAVE,IM,K,DUM(9)                                   AG  12
      EQUIVALENCE (NAME,TRANST,TRANUN)                                  AG  13
      DATA NAME/6LCOMPTY/                                               AG  14
C                                                                       AG  15
      REWIND 1                                                          AG  16
      IF ( RK(1) .GT. FREQ ) GO TO 20                                   AG  17
C                                                                       AG  18
      CALL OVERLAY ( TRANST,3,7 )                                       AG  19
      IF ( NK .EQ. 1 ) GO TO 30                                         AG  20
C                                                                       AG  21
   20 CALL OVERLAY ( TRANUN,3,4 )                                       AG  22
C                                                                       AG  23
   30 REWIND 1                                                          AG  24
      RETURN                                                            AG  25
      END                                                               AG  26
      SUBROUTINE PHIX ( PHIX1, PHIX2, XMACH )                           AH   1
C                                                                       AH   2
      COMMON /GAMA/ GAMMA                                               AH   3
      G1    = 2.0/( GAMMA*XMACH*XMACH )                                 AH   4
      G2    = GAMMA - 1.0                                               AH   5
      G3    = GAMMA/G2                                                  AH   6
      G4    = G2*XMACH*XMACH                                            AH   7
C                                                                       AH   8
      PHIX1 = G1*( ( (2.0+G4)/(2.0+G2*PHIX1*PHIX1) )**G3 - 1.0 )        AH   9
C                                                                       AH  10
      PHIX2 = G1*( ( (2.0+G4)/(2.0+G2*PHIX2*PHIX2) )**G3 - 1.0 )        AH  11
C                                                                       AH  12
      RETURN                                                            AH  13
      END                                                               AH  14
      SUBROUTINE LOGSNG ( TL1, TL2, Y, Z, ETA, NS3, SY2, THETA, RK2 )   AI   1
C                                                                       AI   2
C     SUBROUTINE TO COMPUTE THE LOG SINGULARITY CORRECTION TERM         AI   3
C     FOR NON-COPLANAR SURFACES IN UNSTEADY FLOW.                       AI   4
C                                                                       AI   5
      DIMENSION  ETA(61), SY2(61)                                       AI   6
C                                                                       AI   7
      TL1 = 0.0                                                         AI   8
      TL2 = 0.0                                                         AI   9
      P1  = 3.141563/NS3                                                AI  10
      Z2 = Z*Z                                                          AI  11
      DO 30 JS=1,NS3                                                    AI  12
      S1 = ETA(JS) - Y                                                  AI  13
      S2 = ALOG( ABS( S1*S1 + Z2 ) )*SY2(JS)                            AI  14
      TL1 = TL1 + S2                                                    AI  15
   30 TL2 = TL2 + S2*S1                                                 AI  16
C                                                                       AI  17
      S1 = 1 + Y                                                        AI  18
      S2 = 1 - Y                                                        AI  19
      S3 = S1*S1 + Z2                                                   AI  20
      S4 = S2*S2 + Z2                                                   AI  21
      S5 = ALOG( S3 )                                                   AI  22
      S6 = ALOG( S4 )                                                   AI  23
C                                                                       AI  24
      TL1 = -TL1*P1 + S1*S5 + S2*S6 + 2.0*Z*(ATAN2(S1,Z) +ATAN2(S2,Z) ) AI  25
     1      - 4.0                                                       AI  26
C                                                                       AI  27
      TL2 = -TL2*P1 - 0.5*( S3*S5 - S4*S6 - 4.0*Y )                     AI  28
C                                                                       AI  29
      S1 = 0.25*( RK2*RK2 )*COS( THETA )                                AI  30
C                                                                       AI  31
      TL1 = S1*TL1                                                      AI  32
      TL2 = S1*TL2                                                      AI  33
C                                                                       AI  34
      RETURN                                                            AI  35
      END                                                               AI  36
      FUNCTION DKERN ( Y, Z, THETA )                                    AJ   1
C                                                                       AJ   2
      IF ( Z .NE. 0.0 ) GO TO 10                                        AJ   3
C                                                                       AJ   4
      DKERN = 1.0/( Y*Y )                                               AJ   5
      GO TO 30                                                          AJ   6
C                                                                       AJ   7
   10 IF ( THETA .NE. 0.0 ) GO TO 20                                    AJ   8
C                                                                       AJ   9
      R = 1.0/( Y*Y + Z*Z )                                             AJ  10
      DKERN = R - 2*((R*Z)**2)                                          AJ  11
      GO TO 30                                                          AJ  12
C                                                                       AJ  13
   20 T = Z*( Z*COS(THETA) - Y*SIN(THETA) )                             AJ  14
      R = 1.0/( Y*Y + Z*Z )                                             AJ  15
      DKERN = R*COS(THETA) - T*2.0*R*R                                  AJ  16
C                                                                       AJ  17
   30 RETURN                                                            AJ  18
      END                                                               AJ  19
      SUBROUTINE TRANSF ( THETA, YV, ZV, YR, ZR, YPR, ZPR )             AK   1
C                                                                       AK   2
C     SUBROUTINE TO ROTATE THE DOWNWASH POINT LOCATION THROUGH THETA    AK   3
C     TO THE YPR AND ZPR COORDINATE SYSTEM.                             AK   4
C                                                                       AK   5
      ATHETA = ABS(THETA)                                               AK   6
      IF ( ATHETA .LT. 0.01 ) GO TO 10                                  AK   7
      IF ( ATHETA .LT. 1.56 ) GO TO 20                                  AK   8
      IF ( ATHETA .GT. 1.58 ) GO TO 20                                  AK   9
C                                                                       AK  10
      YPR = ( ZR - ZV )*THETA/ATHETA                                    AK  11
      ZPR = ( YV - YR )*THETA/ATHETA                                    AK  12
      GO TO 100                                                         AK  13
C                                                                       AK  14
   10 YPR = ( YR - YV )                                                 AK  15
      ZPR = ( ZR - ZV )                                                 AK  16
      GO TO 100                                                         AK  17
C                                                                       AK  18
   20 COST = COS( THETA )                                               AK  19
      SINT = SIN( THETA )                                               AK  20
      TANT = SINT/COST                                                  AK  21
      TAN2 = TANT*TANT                                                  AK  22
      TAN3 = 1.0/( 1.0 + TAN2 )                                         AK  23
      DY   = YV - YR                                                    AK  24
      DZ   = ZV - ZR                                                    AK  25
C                                                                       AK  26
      Y2   = ( YR + YV*TAN2 - DZ*TANT )*TAN3                            AK  27
      Z2   = ( ZV + ZR*TAN2 - DY*TANT )*TAN3                            AK  28
C                                                                       AK  29
      DY   = Y2 - YV                                                    AK  30
      Y2   = Y2 - YR                                                    AK  31
      DZ   = Z2 - ZV                                                    AK  32
      Z2   = Z2 - ZR                                                    AK  33
C                                                                       AK  34
      YPR  = DY*COST + DZ*SINT                                          AK  35
      ZPR  = Y2*SINT - Z2*COST                                          AK  36
C                                                                       AK  37
  100 RETURN                                                            AK  38
      END                                                               AK  39
      SUBROUTINE WEIGHT ( SY2, ETA, NS3, T, TN )                        AL   1
C                                                                       AL   2
      DIMENSION SY2(NS3), ETA(NS3), T(NS3), TN(NS3)                     AL   3
C                                                                       AL   4
      T(1) = 4.0/3.141593                                               AL   5
      DO 10 J=3,NS3,2                                                   AL   6
   10 T(J) = -T(1)/(J*(J-2.0) )                                         AL   7
      T(1) = T(1)*0.5                                                   AL   8
C                                                                       AL   9
      TN(1) = 1.0                                                       AL  10
      DO 40 JS=1,NS3                                                    AL  11
      TN(2) = ETA(JS)                                                   AL  12
      ETA2  = 2*ETA(JS)                                                 AL  13
      DO 20 J=3,NS3                                                     AL  14
   20 TN(J) = ETA2*TN(J-1) - TN(J-2)                                    AL  15
C                                                                       AL  16
      SY2(JS) = T(1)                                                    AL  17
      DO 40 J=3,NS3,2                                                   AL  18
   40 SY2(JS) = SY2(JS) + TN(J)*T(J)                                    AL  19
C                                                                       AL  20
      RETURN                                                            AL  21
      END                                                               AL  22
      SUBROUTINE PLNTRM ( T1, T2, T3, Y, Z, THETA, ETA, LSPAN, NS3,     AM   1
     1                    SY2, ETAA, ETAB )                             AM   2
C                                                                       AM   3
      DIMENSION  ETA(61), SY2(61)                                       AM   4
C                                                                       AM   5
      P2  = 3.14159/NS3                                                 AM   6
      IF ( Z .NE. 0.0 ) GO TO 20                                        AM   7
C                                                                       AM   8
      F0 = 0.0                                                          AM   9
      F1 = 0.0                                                          AM  10
      F2 = 0.0                                                          AM  11
      DO 10 JS=1,NS3                                                    AM  12
      IF ( ETA(JS) .LT. ETAA .OR. ETA(JS) .GT. ETAB ) GO TO 10          AM  13
      OY1 = 1.0/( ETA(JS) - Y )                                         AM  14
      F0  = F0 + SY2(JS)*OY1*OY1                                        AM  15
      F1  = F1 + SY2(JS)*OY1                                            AM  16
      F2  = F2 + SY2(JS)                                                AM  17
   10 CONTINUE                                                          AM  18
C                                                                       AM  19
      T1 = 1.0/(ETAA-Y) - 1.0/(ETAB-Y) - P2*F0                          AM  20
      T2 = ALOG( ABS( (ETAB-Y)/(ETAA-Y) ) ) - P2*F1                     AM  21
      T3 = ETAB - ETAA - P2*F2                                          AM  22
      GO TO 100                                                         AM  23
C                                                                       AM  24
   20 IF ( THETA .NE. 0.0 ) GO TO 50                                    AM  25
      Z2 = Z*Z                                                          AM  26
      F0 = 0.0                                                          AM  27
      F1 = 0.0                                                          AM  28
      DO 30 JS=1,NS3                                                    AM  29
      IF ( ETA(JS) .LT. ETAA  .OR. ETA(JS).GT. ETAB ) GO TO 30          AM  30
      R = 1.0/( (Y-ETA(JS))**2 + Z2 )                                   AM  31
      G = R - 2*( (R*Z)**2 )                                            AM  32
      G1= G*( ETA(JS) - Y )                                             AM  33
C                                                                       AM  34
      F0 = F0 + SY2(JS)*G                                               AM  35
      F1 = F1 + SY2(JS)*G1                                              AM  36
   30 CONTINUE                                                          AM  37
C                                                                       AM  38
      YP = Y - ETAA                                                     AM  39
      YM = Y - ETAB                                                     AM  40
      RP = 1.0/( YP*YP + Z2 )                                           AM  41
      RM = 1.0/( YM*YM + Z2 )                                           AM  42
C                                                                       AM  43
      Q0 = ( YM*RM - YP*RP )                                            AM  44
      Q1 = ( ALOG( ABS(RP/RM) )*0.5 + Z2*( RM - RP ) )                  AM  45
C                                                                       AM  46
      T1 = ( Q0 - P2*F0 )                                               AM  47
      T2 = ( Q1 - P2*F1 )                                               AM  48
C                                                                       AM  49
      GO TO 100                                                         AM  50
C                                                                       AM  51
   50 Z2 = Z*Z                                                          AM  52
      F0 = 0.0                                                          AM  53
      F1 = 0.0                                                          AM  54
      F2 = 0.0                                                          AM  55
      DO 60 JS=1,NS3                                                    AM  56
      IF ( ETA(JS) .LT. ETAA  .OR. ETA(JS).GT. ETAB ) GO TO 60          AM  57
      Y0 = Y - ETA(JS)                                                  AM  58
      R  = 1.0/( Y0*Y0 + Z2 )                                           AM  59
      R2 = R*R                                                          AM  60
      G  = R - 2.0*R2*Z2                                                AM  61
      G1 = -G*Y0                                                        AM  62
      H  = R2*Y0*Z                                                      AM  63
C                                                                       AM  64
      F0 = F0 + SY2(JS)*G                                               AM  65
      F1 = F1 + SY2(JS)*G1                                              AM  66
      F2 = F2 + SY2(JS)*H                                               AM  67
   60 CONTINUE                                                          AM  68
C                                                                       AM  69
      YP = Y - ETAA                                                     AM  70
      YM = Y - ETAB                                                     AM  71
      RP = 1.0/( YP*YP + Z2 )                                           AM  72
      RM = 1.0/( YM*YM + Z2 )                                           AM  73
C                                                                       AM  74
      Q0 = ( YM*RM - YP*RP )                                            AM  75
      Q1 = ( ALOG( ABS(RP/RM) )*0.5 + Z2*( RM - RP ) )                  AM  76
      Q2 = Z*( RM - RP )                                                AM  77
C                                                                       AM  78
      T1 = ( Q0 - P2*F0 )                                               AM  79
      T2 = ( Q1 - P2*F1 )                                               AM  80
      T3 = ( Q2 - P2*F2 )                                               AM  81
C                                                                       AM  82
      COSP = COS( THETA )                                               AM  83
      SINP = SIN( THETA )                                               AM  84
C                                                                       AM  85
      T1 = T1*COSP + T3*SINP                                            AM  86
      T2 = T2*COSP                                                      AM  87
C                                                                       AM  88
  100 RETURN                                                            AM  89
      END                                                               AM  90
      SUBROUTINE ETALIM ( ETAA, ETAB, SLE, BETA, XXLE, Y, Z )           AN   1
C                                                                       AN   2
      ETAA = -1.0                                                       AN   3
      ETAB = +1.0                                                       AN   4
C                                                                       AN   5
      IF ( Z .NE. 0.0 ) GO TO 10                                        AN   6
C                                                                       AN   7
      IF ( BETA .LE. SLE ) GO TO 5                                      AN   8
      ETAA = Y - XXLE/( BETA - SLE )                                    AN   9
C                                                                       AN  10
    5 IF ( BETA .LE. -SLE ) GO TO 100                                   AN  11
      ETAB = Y + XXLE/( BETA + SLE )                                    AN  12
      GO TO 100                                                         AN  13
C                                                                       AN  14
   10 B2 = BETA**2                                                      AN  15
      B1 = B2 - SLE**2                                                  AN  16
      Z2 = Z*Z                                                          AN  17
      X2 = XXLE**2                                                      AN  18
C                                                                       AN  19
      IF ( B1 .NE. 0.0 ) GO TO 20                                       AN  20
C                                                                       AN  21
      IF ( BETA .EQ. -SLE ) GO TO 15                                    AN  22
      ETAB = Y + ( X2 - Z2*B2 )/( 2.0*BETA*XXLE )                       AN  23
      GO TO 100                                                         AN  24
C                                                                       AN  25
   15 ETAA = Y - ( X2 - Z2*B2 )/( 2.0*BETA*XXLE )                       AN  26
      GO TO 100                                                         AN  27
C                                                                       AN  28
   20 Y3 = X2 - Z2*B1                                                   AN  29
      IF ( Y3 .GT. 0.0 ) GO TO 25                                       AN  30
      ETAB = -1.0                                                       AN  31
      GO TO 1000                                                        AN  32
C                                                                       AN  33
   25 Y2 = SLE*XXLE/B1                                                  AN  34
      Y3 = SQRT( Y3 )*BETA/B1                                           AN  35
C                                                                       AN  36
      ETAA = Y - ( Y2 + Y3 )                                            AN  37
      ETAB = Y - ( Y2 - Y3 )                                            AN  38
C                                                                       AN  39
      IF ( ETAA .LT. ETAB ) GO TO 100                                   AN  40
C                                                                       AN  41
      IF ( ETAA .GT. Y ) ETAA = -1.0                                    AN  42
      IF ( ETAB .LT. Y ) ETAB = +1.0                                    AN  43
C                                                                       AN  44
  100 IF ( ABS(ETAA) .GT. 1.0 ) ETAA = SIGN( 1.0, ETAA )                AN  45
      IF ( ABS(ETAB) .GT. 1.0 ) ETAB = SIGN( 1.0, ETAB )                AN  46
C                                                                       AN  47
 1000 RETURN                                                            AN  48
      END                                                               AN  49
      OVERLAY(COMPTY,3,7)                                               AO   1
      PROGRAM    TRANST                                                 AO   2
C                                                                       AO   3
C     SUBROUTINE TO CALCULATE THE AERODYNAMIC MATRIX FOR MULTIPLE       AO   4
C     ARBITRARY SURFACES IN STEADY SUBSONIC, MIXED TRANSONIC OR         AO   5
C     SUPERSONIC FLOW.                                                  AO   6
C                                                                       AO   7
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AO   8
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AO   9
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AO  10
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AO  11
C                                                                       AO  12
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AO  13
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AO  14
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AO  15
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AO  16
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AO  17
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AO  18
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AO  19
C                                                                       AO  20
      COMMON /FUNCT/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AO  21
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AO  22
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AO  23
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AO  24
C                                                                       AO  25
      COMMON /GAMA/ GAMMA                                               AO  26
      COMMON /KERN/ GJMU(15,31), CKERNL(67)                             AO  27
      DIMENSION ACOEF(140), D(20)                                       AO  28
      DIMENSION EK(31), GMACHP(31), GMACHM(31)                          AO  29
C                                                                       AO  30
      EQUIVALENCE ( ACOEF(1), A(1) )                                    AO  31
      EQUIVALENCE ( EK(1), B(23) ), ( GMACHP(1), B(65) ),               AO  32
     1                              ( GMACHM(1), B(96) )                AO  33
C                                                                       AO  34
      KR = 0                                                            AO  35
      DO 4000 IS=1,NSURF                                                AO  36
C                                                                       AO  37
      IF ( IS .EQ. 1 ) GO TO 1                                          AO  38
C                                                                       AO  39
      KR = KR + NW2(IS-1)                                               AO  40
      IF ( KSURF(IS-1,IS-1) .LT. 0 ) KR = KR + NS(IS-1)                 AO  41
C                                                                       AO  42
    1 MBAR = NC(IS)                                                     AO  43
      NR   = NS(IS)                                                     AO  44
C                                                                       AO  45
      DO 4000 KS=1,NSURF                                                AO  46
C                                                                       AO  47
      IF ( JSUROP .NE. 0 ) GO TO 5000                                   AO  48
C                                                                       AO  49
      ISTP = ISTYPE(KS)                                                 AO  50
      LSPA = LSPAN(KS)                                                  AO  51
      ICHD = ICHORD(KS)                                                 AO  52
      GO TO 5001                                                        AO  53
C                                                                       AO  54
 5000 LSPA = 5                                                          AO  55
      ISTP = 3                                                          AO  56
      IF ( ISTYPE(KS) .EQ. 4 ) ISTP = 4                                 AO  57
      ICHD = 1                                                          AO  58
C                                                                       AO  59
 5001 IF ( IDUMP .NE. 0 ) WRITE (6,5) IS, KS                            AO  60
    5 FORMAT (1H1,13X," THE DOWNWASH MATRIX FOR THE DOWNWASH INDUCED "  AO  61
     1  ,/,       20X," ON SURFACE ", I2,", BY SURFACE ",I2,// )        AO  62
      IF ( IS .EQ. KS ) GO TO 6                                         AO  63
C                                                                       AO  64
      IF ( KSURF(IS,KS) .GE. 0 ) GO TO 6                                AO  65
      MUNU = NW2(KS)                                                    AO  66
      IF ( KSURF(KS,KS) .LT. 0 ) MUNU = MUNU + NS(KS)                   AO  67
      N = NW2(IS) + KR                                                  AO  68
      IF ( KSURF(IS,IS) .LT. 0 ) N = N + NS(IS)                         AO  69
C                                                                       AO  70
      KRP1 = KR + 1                                                     AO  71
      DO 3 IR=KRP1,N                                                    AO  72
      DO 2 I =1,MUNU                                                    AO  73
    2 ACOEF(I) = 0.0                                                    AO  74
      WRITE (1) ( ACOEF(I), I=1,MUNU )                                  AO  75
      IF ( IDUMP .NE. 0 ) WRITE (6,2700) IR, (ACOEF(I),I=1,MUNU)        AO  76
    3 CONTINUE                                                          AO  77
      GO TO 4000                                                        AO  78
C                                                                       AO  79
    6 IR = KR                                                           AO  80
      SOBR = SO(KS)*BRINV                                               AO  81
      IF ( ISTYPE(KS) .GT. 2 ) SOBR = 0.5*SOBR                          AO  82
      NS2  = NSI(KS)                                                    AO  83
      JJ   = NJ(KS)                                                     AO  84
      JJMIN = 4                                                         AO  85
      NR2  = NS(KS)                                                     AO  86
      MBAR2= NC(KS)                                                     AO  87
      NS3  = NS2                                                        AO  88
      IF ( ISTYPE(KS) .EQ. 3 ) NS3 = NS2/2                              AO  89
C                                                                       AO  90
      COSKS = COS( THETA(KS) )                                          AO  91
      SINKS = SIN( THETA(KS) )                                          AO  92
      IF ( ABS( COSKS ) .LT. 1.0 E-5 ) COSKS = 0.0                      AO  93
      IF ( ABS( SINKS ) .LT. 1.0 E-5 ) SINKS = 0.0                      AO  94
C                                                                       AO  95
      P2 = 2.0*PI*PI/( (2*JJ+1)*NS3 )                                   AO  96
      IF ( IXI(KS) .EQ. 2 ) P2 = PI*PI/( JJ*NS3 )                       AO  97
      P3 = P2*NS3/PI                                                    AO  98
C                                                                       AO  99
      IF ( IS .EQ. KS ) GO TO 20                                        AO 100
C                                                                       AO 101
      CALL UNETA ( UN, ETABAR(1,KS), NS2, NR2, LSYM(KS), ISTP, LSPA )   AO 102
C                                                                       AO 103
      IF ( LSPA .NE. 1 ) GO TO 12                                       AO 104
C                                                                       AO 105
      DO 10 JS=1,NS2                                                    AO 106
      SETA    = 1.0 - ETABAR(JS,KS)**2                                  AO 107
      SY2(JS) = SQRT( SETA )                                            AO 108
      DO 10 JNU=1,NR2                                                   AO 109
   10 UN(JNU,JS) = UN(JNU,JS)*SETA                                      AO 110
      GO TO 20                                                          AO 111
C                                                                       AO 112
   12 CALL WEIGHT ( SY2(1), ETABAR(1,KS), NS3, A, A(71) )               AO 113
C                                                                       AO 114
      IF ( NS3 .NE. NS2 ) CALL WEIGHT ( SY2(NS3+1), ETABAR(NS3+1,KS),   AO 115
     1                                  NS3, A, A(71) )                 AO 116
C                                                                       AO 117
      DO 14 JS=1,NS2                                                    AO 118
      DO 14 JNU=1,NR2                                                   AO 119
   14 UN(JNU,JS) = UN(JNU,JS)*SY2(JS)                                   AO 120
C                                                                       AO 121
   20 ICH = 1                                                           AO 122
      JS1 = NS3                                                         AO 123
      JS2 = 1                                                           AO 124
C                                                                       AO 125
      YV2 = YV(KS)                                                      AO 126
      ZV2 = ZV(KS)                                                      AO 127
      IF ( ISTYPE(KS) .LT. 3 ) GO TO 22                                 AO 128
      YV2 = YV2 + SOBR*COSKS                                            AO 129
      ZV2 = ZV2 + SOBR*SINKS                                            AO 130
C                                                                       AO 131
   22 DO 3000 JR=1,NR                                                   AO 132
C                                                                       AO 133
      JUMP = 1                                                          AO 134
      IF ( IS .NE. KS ) GO TO 24                                        AO 135
C                                                                       AO 136
      Y = YBAR(JR,IS)                                                   AO 137
      Z = 0.0                                                           AO 138
      DTHETA = 0.0                                                      AO 139
      GO TO 25                                                          AO 140
C                                                                       AO 141
   24 CALL TRANSF ( THETA(KS), YV2, ZV2, YS(JR,IS), ZY(JR,IS), Y, Z )   AO 142
C                                                                       AO 143
      Y = Y/SOBR                                                        AO 144
      Z = Z/SOBR                                                        AO 145
      Z2 = 0.01*( 1.0 - ABS(Y) )                                        AO 146
      IF ( SO(IS) .EQ. SO(KS) .AND. NS(IS) .EQ. NS(KS) ) GO TO 23       AO 1461
      IF ( ABS(Z ) .LT. Z2 ) Z = SIGN( Z2, Z )                          AO 147
   23 DTHETA = THETA(IS) - THETA(KS)                                    AO 148
C                                                                       AO 149
      IF ( KSURF(IS,KS) .EQ. 0 ) GO TO 30                               AO 150
      IF ( ABS(Y) .GT. 0.999   ) GO TO 30                               AO 151
C                                                                       AO 152
      JUMP = 0                                                          AO 153
      Y3 = Y + 0.001                                                    AO 154
      CALL UNETA ( DUNY, Y3, 1, NR2, LSYM(KS), ISTP, LSPA )             AO 155
C                                                                       AO 156
   25 CALL UNETA ( UNY,  Y,  1, NR2, LSYM(KS), ISTP, LSPA )             AO 157
C                                                                       AO 158
   30 CALL GEOMTS ( JR, IS, KS, NS2, NS3, JS1, JS2, YV2, ZV2,           AO 159
     1  COSKS*SOBR, SINKS*SOBR, LSPA, ISTP )                            AO 160
C                                                                       AO 161
      IF ( ABS(Y) .LT. 0.999 ) Y2 = SQRT( 1.0 - Y*Y )                   AO 162
C                                                                       AO 163
      IF ( JUMP .NE. 0 ) GO TO 60                                       AO 164
C                                                                       AO 165
      DO 55 I=1,NR2                                                     AO 166
   55 DUNY(I) = 1000.0*( DUNY(I) - UNY(I) )                             AO 167
C                                                                       AO 168
   60 SIGQ = SIGS(1) + 1.0                                              AO 169
      COSP = COS( SIGY(JR,IS) )                                         AO 170
      SINP = SIN( SIGY(JR,IS) )                                         AO 171
      IF ( ABS(COSP) .LT. 1.0 E-5 ) COSP = 0.0                          AO 172
      IF ( ABS(SINP) .LT. 1.0 E-5 ) SINP = 0.0                          AO 173
C                                                                       AO 174
      DO 3000 JI=1,MBAR                                                 AO 175
C                                                                       AO 176
      Y5 = YBAR(JR,IS)                                                  AO 177
      IF ( ISTYPE(IS) .LT. 3 ) Y5 = 2*Y5 - 1.0                          AO 178
C                                                                       AO 179
      GMACH = XMACH                                                     AO 180
      IF ( ITRANS(IS) .NE. 0 )                                          AO 181
     1CALL CALCM ( XBAR(JI,IS), Y5, MBAR, NR, BMACH(1,IS), GMACH,       AO 182
     2             B(1), B(12) )                                        AO 183
C                                                                       AO 184
      JJ = NJ(KS)                                                       AO 185
      IR = IR + 1                                                       AO 186
      BETA2 = 1.0 - GMACH**2                                            AO 187
      BETA  = SQRT( ABS(BETA2) )                                        AO 188
C                                                                       AO 189
      IF ( JUMP .NE. 0 .AND. IS .NE. KS ) GO TO 250                     AO 190
      ETAA = -1.0                                                       AO 191
      ETAB =  1.0                                                       AO 192
      IF ( GMACH .LT. 1.0 ) GO TO 240                                   AO 193
C                                                                       AO 194
      SLE = ( BRPT(1,3,KS) - BRPT(1,1,KS) )/SO(KS)                      AO 195
      YP  = Y*SOBR                                                      AO 196
      IF ( ISTYPE(KS) .GT. 1 ) YP = YP + SOBR                           AO 197
      XXLE = (XS(JI,JR,IS) - ( XV(KS) - BO(KS)*BRINV + YP*SLE ) )/SOBR  AO 198
C                                                                       AO 199
      CALL ETALIM ( ETAA, ETAB, SLE, BETA, XXLE, Y, Z )                 AO 200
C                                                                       AO 201
C                                                                       AO 202
  240 CALL PLNTRM ( T1, T2, T3, Y, Z, DTHETA, ETAB2, LSPA, NS3, SY2,    AO 203
     1              ETAA, ETAB )                                        AO 204
C                                                                       AO 205
  250 JS3 = 0                                                           AO 206
      DELT = 1.0 - ABS( YBAR(1,IS) )                                    AO 207
  201 DO 200 JS=1,NS2                                                   AO 208
      MULT = 1                                                          AO 209
      IF ( ABS( ETAB2(JS) - Y ) .LT. DELT .OR. JS3 .EQ. 62 ) MULT = 3   AO 210
C                                                                       AO 211
      IF ( GMACH .GE. 1.0 ) GO TO 70                                    AO 212
C                                                                       AO 213
      IF ( MULT .NE. 1 ) GO TO 62                                       AO 214
C                                                                       AO 215
      JJ = NJ(KS)                                                       AO 216
      DO 61 J=1,JJ                                                      AO 217
   61 XICT(J) = XIBAR(J,KS)                                             AO 218
      GO TO 64                                                          AO 219
C                                                                       AO 220
   62 JJ = NJ(KS)*MULT                                                  AO 221
      IF ( IXI(KS) .NE. 2 ) JJ = JJ + 1                                 AO 222
      P2 = PI/(2*JJ+1)                                                  AO 223
      IF ( IXI(KS) .EQ. 2 ) P2 = PI/(2*JJ)                              AO 224
      DO 63 J=1,JJ                                                      AO 225
   63 XICT(J) = -COS( (2*J-1)*P2 )                                      AO 226
C                                                                       AO 227
   64 P3 = PI/JJ                                                        AO 228
      IF ( IXI(KS) .NE. 2 ) P3 = 2.0*PI/( 2*JJ+1.0 )                    AO 229
C                                                                       AO 230
      CALL TNXI ( TN, XICT, JJ, MBAR2, ICHD )                           AO 231
      IF ( JSUROP .NE. 0 ) GO TO 100                                    AO 232
C                                                                       AO 233
      DO 65 J=1,JJ                                                      AO 234
      Z3 = 1.0 - XICT(J)                                                AO 235
      DO 65 JMU=1,MBAR2                                                 AO 236
      W1(J) = 1.0                                                       AO 237
   65 TN(JMU,J) = TN(JMU,J)*Z3                                          AO 238
      GO TO 100                                                         AO 239
C                                                                       AO 240
   70 IF ( IS .NE. KS ) GO TO 100                                       AO 241
C                                                                       AO 242
      JJ = ( JJMIN + JI )*MULT                                          AO 243
      NJ3 = JJ                                                          AO 244
      P2  = PI/( 2*NJ3 )                                                AO 245
      DO 80 J=1,NJ3                                                     AO 246
   80 XICT(J) = -COS( (2*J-1)*P2 )                                      AO 247
C                                                                       AO 248
  100 IF ( JS3 .EQ. 62 ) GO TO 202                                      AO 249
C                                                                       AO 250
C                                                                       AO 251
      CALL TSTGEO ( JR, JI, JJ, JS, P3, NS3, IS, KS, COSKS, COSKS2, IR )AO 252
C                                                                       AO 253
      IF ( P3 .NE. 0.0 ) GO TO 110                                      AO 254
C                                                                       AO 255
      DO 105 JMU=1,MBAR2                                                AO 256
  105 GJMU(JMU,JS) = 0.0                                                AO 257
      GO TO 200                                                         AO 258
C                                                                       AO 259
  110 CALL TKERNS ( CKERNL, GMACH, JJ, 1,                               AO 260
     1     XS(JI,JR,IS), YS(JR,IS), ZY(JR,IS), COSP, SINP, SIGS(JS),    AO 261
     2     XIS2, ETAS2(JS), ZETAS(JS), COSKS , SINKS )                  AO 262
C                                                                       AO 263
      IF ( GMACH .GE. 1.0 ) CALL TNXI ( TN, XIB2, JJ, MBAR2, +1 )       AO 264
C                                                                       AO 265
  120 CALL TSTPSI ( JR, JI, IS, KS, JS, P3, JJ, MBAR2, NS3, IR,         AO 266
     1              COSP, SINP, COSKS, SINKS )                          AO 267
      DO 130 JMU=1,MBAR2                                                AO 268
      GETA(JMU) =  HPSI(JMU,1)                                          AO 269
      DO 130 J=1,JJ                                                     AO 270
  130 GETA(JMU) = GETA(JMU) + ( TN(JMU,J)*W1(J) )*CKERNL(J)             AO 271
C                                                                       AO 272
      DO 140 JMU=1,MBAR2                                                AO 273
  140 GJMU(JMU,JS) = GETA(JMU)*P3                                       AO 274
C                                                                       AO 275
  200 CONTINUE                                                          AO 276
C                                                                       AO 277
      IF ( JUMP .NE. 0 .AND. IS .NE. KS ) GO TO 210                     AO 278
C                                                                       AO 279
      JS3 = 62                                                          AO 280
      GO TO 201                                                         AO 281
C                                                                       AO 282
  202 CALL TSTGEO ( JR, JI, JJ, 62, P3, NS3, IS, KS, COSKS, COSKS2, IR )AO 283
C                                                                       AO 284
      CALL TSTPSI ( JR, JI, IS, KS, 62, P3, JJ, MBAR2, NS3, IR,         AO 285
     1              COSP, SINP, COSKS, SINKS )                          AO 286
C                                                                       AO 287
  210 MUNU = 0                                                          AO 288
      Y4 = Y*SO(KS)                                                     AO 289
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AO 290
C                                                                       AO 291
      DO 2000 JMU=1,MBAR2                                               AO 292
      DO 2000 JNU=1,NR2                                                 AO 293
      MUNU = MUNU + 1                                                   AO 294
C                                                                       AO 295
C     CALCULATION OF THE DOUBLE INTEGRALS WITH THE CHORDWISE            AO 296
C     INTEGRALS FROM AB0VE CONTAINED IN ARRAY GJMU(JMU,JS).             AO 297
C                                                                       AO 298
      D(1) = 0.0                                                        AO 299
      DO 300 JS=1,NS2                                                   AO 300
      GETA(JS) = GJMU(JMU,JS)*UN(JNU,JS)                                AO 301
  300 D(1) = D(1) + GETA(JS)                                            AO 302
      D(1) = D(1)*(SOBR**2)*PI/NS3                                      AO 303
C                                                                       AO 304
      IF ( IS .NE. KS ) GO TO 400                                       AO 305
      IF ( JNU .GT. 1 ) GO TO 310                                       AO 306
C                                                                       AO 307
*     WRITE (6,2223) D(1), ( GETA(JS), JS=1,NS2 )                       AO 308
*2223 FORMAT (1H ,/,* D(1) = *,E14.7,* GETA = *,//, (10E12.4) )         AO 309
      IF ( GMACH .GE. 1.0 ) GO TO 301                                   AO 310
      D(2) = HPSI(JMU,1)*2.0*P3                                         AO 311
C                                                                       AO 312
C     D(2) IS THE CORRECTED DOWNWASH CHORD INTEGRAL COMPUTED            AO 313
C     AS HPSI(JMU,62) IN TSTPSI.                                        AO 314
C                                                                       AO 315
      IF ( LSPAN(IS) .EQ. 1 ) D(2) = D(2)*Y2                            AO 316
 301  M1 = NS3                                                          AO 317
      M2 = 1                                                            AO 318
C                                                                       AO 319
      ETA1 = ETAB2(M1) - YBAR(JR,IS)                                    AO 320
      ETA2 = ETAB2(M2) - YBAR(JR,IS)                                    AO 321
      S1   = ( (ETA1*SOBR)**2 )/SY2(M1)                                 AO 322
      S2   = ( (ETA2*SOBR)**2 )/SY2(M2)                                 AO 323
      IF ( GMACH .LT. 1.0 ) GO TO 310                                   AO 324
C                                                                       AO 325
      ETA4  = ETAB2(M2+1) - YBAR(JR,IS)                                 AO 326
      Y1Y2  = ( ETA4/ETA1 )**2                                          AO 327
      QC(1) = ( (ETA4*SOBR)**2 )/SY2(M1-1)                              AO 328
      QC(2) = S1                                                        AO 329
      QC(3) = S2                                                        AO 330
      QC(4) = ( (ETA4*SOBR)**2 )/SY2(M2+1)                              AO 331
C                                                                       AO 332
      D(2) = -( GETA(M1-1)*QC(1) + GETA(M2+1)*QC(4) - ( GETA(M1)*QC(2)  AO 333
     1        + GETA(M2)*QC(3) )*Y1Y2 )/( 2*UNY(1)*( 1 - Y1Y2 ) )       AO 334
C                                                                       AO 335
  310 GYY   = D(2)*UNY(JNU)                                             AO 336
      D(11) = -GETA(M1)*S1                                              AO 337
      D(13) = -GETA(M2)*S2                                              AO 338
      D(12) = GYY                                                       AO 339
*     WRITE (6,2222) ( D(I), I=11,13 )                                  AO 340
*2222 FORMAT (1H ,/,* D(JR-1) = *,E14.7,*  D(JR) = *,E14.7,*  D(JR+1) = AO 341
*    1*,E14.7 )                                                         AO 342
C                                                                       AO 343
      D(20) = ( ( D(11) - D(12) ) - ( D(13) - D(12) )*ETA1/ETA2 )/      AO 344
     1          ( ETA1**2 - ETA1*ETA2 )                                 AO 345
      D(19) = ( D(11) - D(12) )/ETA1 - D(20)*ETA1                       AO 346
      D(18) = D(12)                                                     AO 347
C                                                                       AO 348
      D(1)  = D(1) - ( D(18)*T1 + D(19)*T2 + D(20)*T3 )                 AO 349
C                                                                       AO 350
      GO TO 500                                                         AO 351
C                                                                       AO 352
  400 IF ( JUMP .NE. 0 ) GO TO 500                                      AO 353
C                                                                       AO 354
      IF ( JNU .GT. 1 ) GO TO 410                                       AO 355
C                                                                       AO 356
      D(2) = HPSI(JMU,1)*2.0*P3                                         AO 357
C                                                                       AO 358
      Q1 = T1                                                           AO 359
      Q2 = T2                                                           AO 360
C                                                                       AO 361
      IF ( LSPAN(KS) .NE. 1 ) GO TO 410                                 AO 362
C                                                                       AO 363
      Q1 = T1*Y2 - T2*Y/Y2                                              AO 364
      Q2 = T2*Y2                                                        AO 365
C                                                                       AO 366
  410 D(1) = D(1) - D(2)*( Q1*UNY(JNU) + Q2*DUNY(JNU) )                 AO 367
C                                                                       AO 368
  500 IF ( ISTYPE(KS) .GT. 2 ) D(1) = 2.0*D(1)                          AO 369
C                                                                       AO 370
 2000 ACOEF(MUNU) = D(1)*XMACH/GMACH                                    AO 371
C                                                                       AO 372
      IF ( KSURF(KS,KS) .GE. 0 ) GO TO 2600                             AO 373
C                                                                       AO 374
C     FOR THE KS'TH SURFACE TO BE THE SUBSONIC SURFACE OF A TRANSONIC   AO 375
C     PAIR, THE DOWNWASH DUE TO THE SH0CK LINE DOUBLET MUST BE          AO 376
C     CALCULATED ON THE IS'TH SURFACE. THIS IS PERFORMED IF             AO 377
C     KSURF(KS,KS) IS LT. ZERO.                                         AO 378
C                                                                       AO 379
      DO 2200 JS=1,NS2                                                  AO 380
C                                                                       AO 381
      IF ( JS .LE. NS3 .AND. IS .EQ. KS ) GO TO 2015                    AO 382
      BY  = BETABO(JS,KS)                                               AO 383
      XSH = XISLTE(1,JS,KS)                                             AO 384
      GO TO 2020                                                        AO 385
C                                                                       AO 386
 2015 Y5 = ETAB2(JS)*SO(KS)                                             AO 387
      IF ( ISTYPE(KS) .GT. 2 ) Y5 = 0.5*( Y5 + SO(KS) )                 AO 388
C                                                                       AO 389
      CALL XMBY ( XM, BY, Y5, BRPT(1,1,KS), NEND(KS) )                  AO 390
C                                                                       AO 391
      XSH = ( XM - BY )*BRINV + XV(KS)                                  AO 392
C                                                                       AO 393
 2020 IF ( GMACH .LT. 1.0 ) GO TO 2100                                  AO 394
C                                                                       AO 395
      R = SQRT( ( YS(JR,IS) - ETAS2(JS) )**2                            AO 396
     1        + ( ZY(JR,IS) - ZETAS(JS) )**2 )*BETA                     AO 397
      XMC = XS(JI,JR,IS) - R                                            AO 398
      IF ( XMC .GT. XSH ) GO TO 2100                                    AO 399
C                                                                       AO 400
      GJMU(1,JS) = 0.0                                                  AO 401
      GO TO 2200                                                        AO 402
C                                                                       AO 403
 2100 CALL TKERNS ( CKER, GMACH, 1, 1,                                  AO 404
     1     XS(JI,JR,IS), YS(JR,IS), ZY(JR,IS), COSP, SINP, SIGS(JS),    AO 405
     2     XSH, ETAS2(JS), ZETAS(JS), COSKS, SINKS )                    AO 406
C                                                                       AO 407
      GJMU(1,JS) = CKER                                                 AO 408
C                                                                       AO 409
 2200 CONTINUE                                                          AO 410
C                                                                       AO 411
      D(2) = 2.0                                                        AO 412
      IF ( IS .EQ. KS .AND. LSPAN(IS) .EQ. 1 ) D(2) = 2*Y2              AO 413
C                                                                       AO 414
      DO 2500 JNU=1,NR2                                                 AO 415
      MUNU = MUNU + 1                                                   AO 416
      D(1) = 0.0                                                        AO 417
      DO 2250 JS=1,NS2                                                  AO 418
      GETA(JS) = GJMU(1,JS)*UN(JNU,JS)                                  AO 419
 2250 D(1) = D(1) + GETA(JS)                                            AO 420
      D(1) = D(1)*(SOBR**2)*AR(KS)*PI/NS3                               AO 421
C                                                                       AO 422
      IF ( IS .NE. KS ) GO TO 2300                                      AO 423
C                                                                       AO 424
      D(11) = -GETA(M1)*S1                                              AO 425
      D(12) = D(2)*UNY(JNU)                                             AO 426
      D(13) = -GETA(M2)*S2                                              AO 427
*     WRITE (6,2224) D(1), T1, T2, T3                                   AO 428
*2224 FORMAT (/,*    D(1) = *,E14.7, *  T1,T2,T3 = *, 3E14.7    )       AO 429
*     WRITE (6,2222) ( D(I), I=11,13 )                                  AO 430
C                                                                       AO 431
      D(20) = ( ( D(11) - D(12) ) - ( D(13) - D(12) )*ETA1/ETA2 )/      AO 432
     1          ( ETA1**2 - ETA1*ETA2 )                                 AO 433
      D(19) = ( D(11) - D(12) )/ETA1 - D(20)*ETA1                       AO 434
      D(18) = D(12)                                                     AO 435
C                                                                       AO 436
      D(1)  = D(1) - ( D(18)*T1 + D(19)*T2 + D(20)*T3 )*AR(KS)          AO 437
C                                                                       AO 438
      GO TO 2400                                                        AO 439
C                                                                       AO 440
 2300 IF ( JUMP .NE. 0 ) GO TO 2400                                     AO 441
C                                                                       AO 442
      D(1) = D(1) - D(2)*( Q1*UNY(JNU) + Q2*DUNY(JNU) )*AR(KS)          AO 443
C                                                                       AO 444
 2400 IF ( ISTYPE(KS) .GT. 2 ) D(1) = 2.0*D(1)                          AO 445
C                                                                       AO 446
 2500 ACOEF(MUNU) = D(1)*XMACH/( GMACH*SOBR )                           AO 447
C                                                                       AO 448
 2600 WRITE (1) ( ACOEF(I), I=1,MUNU )                                  AO 449
C                                                                       AO 450
      IF ( IDUMP .NE. 0 ) WRITE (6,2700) IR, ( ACOEF(I), I=1,MUNU )     AO 451
C                                                                       AO 452
 2700 FORMAT (/,9X,"A COEFFICIENTS FOR ROW ",I3, //, ( 3X, 5E15.7 ) )   AO 453
C                                                                       AO 454
 3000 CONTINUE                                                          AO 455
C                                                                       AO 456
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 4000                             AO 457
C                                                                       AO 458
C     THE PRESSURE AND POTENTIAL VALUES ACROSS THE SHOCK ARE CALCULATED AO 459
C     AT THE YBAR STATIONS FOR SATISFYING THE NORMAL SHOCK B.C.'S       AO 460
C      (PHIX+) - K*(PHI+)  + M(BAR)*(PHIX-) + K*(PHI-) = 0              AO 461
C                                                                       AO 462
C     THIS SECTION IS CURRENTLY RESTRICTED TO COPLANAR SURFACES FOR     AO 463
C     WHICH THE SPAN OF DOWNSTREAM SURFACES IS .LE. TO THOSE UPSTREAM.  AO 464
C                                                                       AO 465
      ZMBAR = ( GAMMA-1.0 + 2.0/((  XMACH)**2) )/( GAMMA+1.0 )          AO 466
C                                                                       AO 467
      DO 3500 JR=1,NR                                                   AO 468
C                                                                       AO 469
      IF ( IS .EQ. KS ) GO TO 3010                                      AO 470
C                                                                       AO 471
      DO 3005 I=1,MUNU                                                  AO 472
 3005 ACOEF(I) = 0.0                                                    AO 473
      IF( IABS( KSURF(KS,KS) ) .NE. IS ) GO TO 3450                     AO 474
C                                                                       AO 475
C                                                                       AO 476
      CALL TRANSF ( THETA(KS), YV2, ZV2, YS(JR,IS), ZY(JR,IS), Y5, Z )  AO 477
C                                                                       AO 478
      Y  = Y5/SOBR                                                      AO 479
      Z  =  Z/SOBR                                                      AO 480
      Z2 = 0.01*( 1.0 - ABS(Y) )                                        AO 481
      IF ( ABS(Z) .LT. Z2 ) Z = SIGN( Z2,Z )                            AO 482
      DTHETA = THETA(IS) - THETA(KS)                                    AO 483
      Y5 = Y5*BREF                                                      AO 484
      IF ( ISTYPE(KS) .GT. 2 ) Y5 = 0.5*( Y5 + SO(KS) )                 AO 485
C                                                                       AO 486
      CALL XMBY ( XM, BY, Y5, BRPT(1,1,KS), NEND(KS) )                  AO 487
      XSH = ( XM + BY )*BRINV + XV(KS)                                  AO 488
      GO TO 3020                                                        AO 489
C                                                                       AO 490
 3010 Y  = YBAR(JR,IS)                                                  AO 491
      Z  = 0.0                                                          AO 492
      BY = BYBO(JR,IS)                                                  AO 493
      XSH = XS(1,JR,IS) - ( XBAR(1,IS) - 1.0 )*BY                       AO 494
C                                                                       AO 495
 3020 CALL UNETA ( UNY, Y, 1, NR2, LSYM(KS), ISTYPE(KS), LSPAN(KS) )    AO 496
C                                                                       AO 497
      Y2 = -SQRT( 1.0 - Y*Y )                                           AO 498
C                                                                       AO 499
C                                                                       AO 500
      YB = YBAR(JR,IS)                                                  AO 501
      IF ( ISTYPE(IS) .LT. 3 ) YB = 2*YB - 1.0                          AO 502
C                                                                       AO 503
      CALL CALCM ( -1.0, YB, MBAR, NR, BMACH(1,IS), PHIP, B(1), B(12) ) AO 504
      CALL CALCM ( -.99, YB, MBAR, NR, BMACH(1,IS), PHIPX,B(1), B(12) ) AO 505
      GMACHP(JR) =  PHIP                                                AO 506
      CALL PHIX ( PHIP, PHIPX, XMACH )                                  AO 507
      PHIPX = 100.0*( PHIPX - PHIP )/BYBO(JR,IS)                        AO 508
C                                                                       AO 509
      KT = -KSURF(IS,IS)                                                AO 510
C                                                                       AO 511
      CALL CALCM ( +1.0, YB, MBAR2, NR2, BMACH(1,KT), PHIM, B(1),B(12)) AO 512
      CALL CALCM ( +.99, YB, MBAR2, NR2, BMACH(1,KT), PHIMX,B(1),B(12)) AO 513
      GMACHM(JR) = PHIM                                                 AO 514
      CALL PHIX ( PHIM, PHIMX, XMACH )                                  AO 515
      PHIMX = 100.0*( PHIM - PHIMX )/BYBO(JR,KT)                        AO 516
C                                                                       AO 517
      EK(JR) = ( PHIPX + ZMBAR*PHIMX )/( PHIP - PHIM )                  AO 518
C                                                                       AO 519
 3030 IF ( IS .EQ. KS ) GO TO 3100                                      AO 520
C                                                                       AO 521
C                                                                       AO 522
 3050 MUNU = 0                                                          AO 523
      DO 3060 JMU=1,MBAR2                                               AO 524
      DO 3060 JNU=1,NR2                                                 AO 525
      MUNU = MUNU + 1                                                   AO 526
C                                                                       AO 527
 3060 ACOEF(MUNU) = 0.0                                                 AO 528
C                                                                       AO 529
      IF ( KSURF(KS,KS) .NE. IS ) GO TO 3080                            AO 530
C                                                                       AO 531
      X3 = 0.999                                                        AO 532
      Q3 = SQRT ( 0.001/1.999 )                                         AO 533
C                                                                       AO 534
      CALL TNXI ( TNX, X3, 1, MBAR2, ICHORD(KS) )                       AO 535
C                                                                       AO 536
      CONST = 2*SOBR*ZMBAR/BYBO(JR,KS)                                  AO 537
      IF ( ISTYPE(KS) .GT. 2 ) CONST = 2.0*CONST                        AO 538
C                                                                       AO 539
      MUNU = 0                                                          AO 540
      DO 3070 JMU=1,MBAR2                                               AO 541
      DO 3070 JNU=1,NR2                                                 AO 542
      MUNU = MUNU + 1                                                   AO 543
C                                                                       AO 544
 3070 ACOEF(MUNU) = ACOEF(MUNU) + TNX(JMU,1)*UNY(JNU)*CONST*Q3          AO 545
 3080 IF ( KSURF(KS,KS) ) 3120, 3400, 3400                              AO 546
C                                                                       AO 547
 3100 X3 = -0.999                                                       AO 548
      Q3 = SQRT ( 1.999/0.001 )                                         AO 549
C                                                                       AO 550
      CALL TNXI ( TNX, X3, 1, MBAR2, ICHORD(KS) )                       AO 551
C                                                                       AO 552
      CONST = 2*SOBR/BYBO(JR,KS)                                        AO 553
      IF ( ISTYPE(KS) .GT. 2 ) CONST = 2.0*CONST                        AO 554
C                                                                       AO 555
      MUNU = 0                                                          AO 556
      DO 3110 JMU=1,MBAR2                                               AO 557
      DO 3110 JNU=1,NR2                                                 AO 558
      MUNU = MUNU + 1                                                   AO 559
C                                                                       AO 560
 3110 ACOEF(MUNU) = TNX(JMU,1)*UNY(JNU)*CONST*Q3                        AO 561
C                                                                       AO 562
 3120 CONST = -2*EK(JR)*AR(KS)                                          AO 563
C                                                                       AO 564
      DO 3130 JNU=1,NR2                                                 AO 565
      MUNU = MUNU + 1                                                   AO 566
C                                                                       AO 567
 3130 ACOEF(MUNU) =  UNY(JNU)*CONST                                     AO 568
C                                                                       AO 569
 3400 IF ( LSPAN(KS) .NE. 1 ) Y2 = -1.0                                 AO 570
C                                                                       AO 571
      DO 3440 I=1,MUNU                                                  AO 572
 3440 ACOEF(I) = Y2*ACOEF(I)                                            AO 573
C                                                                       AO 574
 3450 WRITE (1) ( ACOEF(I), I=1,MUNU )                                  AO 575
C                                                                       AO 576
 3405 IF ( IDUMP .NE. 0 ) WRITE (6,3410) JR, ( ACOEF(I), I=1,MUNU )     AO 577
C                                                                       AO 578
 3410 FORMAT (/,9X,"SHOCK BC.S FOR DOWNWASH ROW ",I2,//,( 3X,5E15.7 ) ) AO 579
C                                                                       AO 580
 3500 CONTINUE                                                          AO 581
C                                                                       AO 582
 4000 CONTINUE                                                          AO 583
      END                                                               AO 584
      SUBROUTINE TSTPSI ( JR, JI, IS, KS, JS, P3, JJ, MBAR2, NS3, IR,   AP   1
     1                    COSP, SINP, COSKS, SINKS )                    AP   2
C     SUBROUTINE TO CALCULATE THE CHORDWISE INTEGRAL CORRECTION TERM    AP   3
C     AND THE DOWNWASH CHORD INTEGRAL IN TRANSONIC FLOW.                AP   4
C                                                                       AP   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AP   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AP   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AP   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AP   9
C                                                                       AP  10
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AP  11
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AP  12
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AP  13
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AP  14
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AP  15
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AP  16
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AP  17
C                                                                       AP  18
      COMMON /FUNCT/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AP  19
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AP  20
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AP  21
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AP  22
C                                                                       AP  23
      SOBR = SO(KS)*BRINV                                               AP  24
      IF ( ISTYPE(KS) .GT. 2 ) SOBR = SOBR*0.5                          AP  25
      Z1 = Z*SOBR                                                       AP  26
C                                                                       AP  27
      IF ( GMACH .GE. 1.0 ) GO TO 30                                    AP  28
C                                                                       AP  29
      IF ( JS .NE. 62 ) GO TO 200                                       AP  30
C                                                                       AP  31
      IF ( Z .NE. 0.0 ) GO TO 50                                        AP  32
C                                                                       AP  33
      DO 20 JMU=1,MBAR2                                                 AP  34
      HPSI(JMU,1) = 0.0                                                 AP  35
      DO 10 J=1,JJ                                                      AP  36
      IF ( XIS2(J) .GT. XS(JI,JR,IS)) GO TO 20                          AP  37
   10 HPSI(JMU,1) = HPSI(JMU,1) + W1(J)*TN(JMU,J)                       AP  38
   20 CONTINUE                                                          AP  39
      GO TO 1000                                                        AP  40
C                                                                       AP  41
   30 IF ( JS .NE. 62 .AND. Z .EQ. 0.0 ) GO TO 200                      AP  42
C                                                                       AP  43
      CALL TNXI ( TN, XIB2, JJ, MBAR2, +1 )                             AP  44
C                                                                       AP  45
      IF ( Z .NE. 0.0 ) GO TO 50                                        AP  46
C                                                                       AP  47
      DO 40 JMU=1,MBAR2                                                 AP  48
      HPSI(JMU,1) = 0.0                                                 AP  49
      DO 40 J=1,JJ                                                      AP  50
   40 HPSI(JMU,1) = HPSI(JMU,1) + W1(J)*TN(JMU,J)                       AP  51
      GO TO 1000                                                        AP  52
C                                                                       AP  53
   50 COSP2 = COSP*COSKS + SINP*SINKS                                   AP  54
      SINP2 = SINP*COSKS - COSP*SINKS                                   AP  55
C                                                                       AP  56
      IF ( JS .NE. 62 ) GO TO 100                                       AP  57
C                                                                       AP  58
      CKINF = Z1*Z1*0.5/COSP2                                           AP  59
C                                                                       AP  60
      CALL TKERNS ( HPSI(1,2), GMACH, JJ, 1, XS(JI,JR,IS),              AP  61
     1     0.0,Z1, COSP2, SINP2, (SIGETA(1,KS)-SIGY(JR,IS)),            AP  62
     2     XIS2, 0.0, 0.0, 1.0, 0.0 )                                   AP  63
C                                                                       AP  64
      DO 60 J=1,JJ                                                      AP  65
   60 HPSI(J,2) = HPSI(J,2)*CKINF*W1(J)                                 AP  66
C                                                                       AP  67
      DO 70 JMU=1,MBAR2                                                 AP  68
      HPSI(JMU,1) = 0.0                                                 AP  69
      DO 70 J=1,JJ                                                      AP  70
   70 HPSI(JMU,1) = HPSI(JMU,1) + TN(JMU,J)*HPSI(J,2)                   AP  71
C                                                                       AP  72
      IF ( GMACH .LT. 1.0 ) GO TO 1000                                  AP  73
      GO TO 120                                                         AP  74
C                                                                       AP  75
  100 DO 110 JMU=1,MBAR2                                                AP  76
  110 HPSI(JMU,1) = 0.0                                                 AP  77
      Y0 = YS(JR,IS) - ETAS2(JS)                                        AP  78
      Z0 = ZY(JR,IS) - ZETAS(JS)                                        AP  79
      R2 = Y0**2 + Z0**2                                                AP  80
      T2 =-(Z0*COSP-Y0*SINP)*(Z0*COSKS-Y0*SINKS)*2.0*BETA2/R2           AP  81
      GO TO 130                                                         AP  82
C                                                                       AP  83
  120 R2 = Z1*Z1                                                        AP  84
      T2 = -BETA2*0.5/COSP2                                             AP  85
C                                                                       AP  86
  130 XLE = YQ(1)                                                       AP  87
      BY = YQ(2)                                                        AP  88
      XISH = (XMC-XLE)*(XIB2(JJ)-XIB2(1))/(XIS2(JJ)-XIS2(1)) - 1.0      AP  89
      XSH = XMC                                                         AP  90
      IF ( XISH .GT. 1.0 ) GO TO 1000                                   AP  91
C                                                                       AP  92
  135 CALL TNXI ( TNX(1,1), XISH, 1 , MBAR2, 1 )                        AP  93
      IND = 0                                                           AP  94
      CALL CHDTSS ( PSH, XISH, XISH, 1, ICHORD(KS), LSPAN(KS), IND, 1,  AP  95
     1              XMACH, BRPT(1,1,KS), YQ(3), JSUROP )                AP  96
C                                                                       AP  97
      C1 = 1.0/( P3*BY*SQRT( (XLE-XS(JI,JR,IS))**2 + BETA2*R2 ) )       AP  98
      IF ( JSUROP .EQ. 0 ) GO TO 139                                    AP  99
      IF ( ISTYPE(KS) .GT. 2 ) C1 = C1*2                                AP 100
      C1 = C1*BREF/SO(KS)                                               AP 101
C                                                                       AP 102
  139 DO 140 J=1,JJ                                                     AP 103
      X0 = XS(JI,JR,IS) - XIS2(J)                                       AP 104
  140 C1 = C1 + X0*SQRT( (1-XICT(J)**2)/( ( X0**2 + BETA2*R2 )**3 ) )   AP 105
      C1 = C1*T2*PSH                                                    AP 106
      DO 150 JMU=1,MBAR2                                                AP 107
  150 HPSI(JMU,1) = HPSI(JMU,1) + C1*TNX(JMU,1)                         AP 108
      GO TO 1000                                                        AP 109
C                                                                       AP 110
  200 DO 210 JMU=1,MBAR2                                                AP 111
  210 HPSI(JMU,1) = 0.0                                                 AP 112
C                                                                       AP 113
 1000 RETURN                                                            AP 114
      END                                                               AP 115
      SUBROUTINE TSTGEO ( JR, JI, JJ, JS, P3, NS3, IS, KS,              AQ   1
     1                    COSKS, COSK2, IR )                            AQ   2
C                                                                       AQ   3
C     SUBROUTINE TO CALCULATE THE CHORDWISE INTEGRATION POINT ARRAY     AQ   4
C     AT THE JS STATION AND OTHER GEOMETRIC DATA.                       AQ   5
C                                                                       AQ   6
C                                                                       AQ   7
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AQ   8
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AQ   9
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AQ  10
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AQ  11
C                                                                       AQ  12
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AQ  13
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AQ  14
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AQ  15
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AQ  16
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AQ  17
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AQ  18
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AQ  19
C                                                                       AQ  20
      COMMON /FUNCT/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AQ  21
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AQ  22
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AQ  23
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AQ  24
C                                                                       AQ  25
      IF ( JS .EQ. 1 ) IND = 0                                          AQ  26
      BRAT = 0.0                                                        AQ  27
      IF ( JSUROP .EQ. 0 .AND. GMACH .LT. 1.0 ) GO TO 500               AQ  28
      IF ( JS .NE. 62 ) GO TO 10                                        AQ  29
      IF ( IS .NE. KS ) GO TO 5                                         AQ  30
      Y4  = Y*SO(KS)                                                    AQ  31
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AQ  32
      BY  = BYBO(JR,IS)                                                 AQ  33
      R   = 0                                                           AQ  34
      XMC = XS(JI,JR,IS)                                                AQ  35
      XLE = XMC - BYBO(JR,IS)*( XBAR(JI,IS) + 1.0 )                     AQ  36
      GO TO 100                                                         AQ  37
C                                                                       AQ  38
    5 Z4  = Z*SO(KS)                                                    AQ  39
      IF ( ISTYPE(KS) .GT. 2 ) Z4 = 0.5*Z4                              AQ  40
      R   = ABS( Z4*BRINV )*BETA                                        AQ  41
      XMC = XS(JI,JR,IS) - R                                            AQ  42
      Y4  = Y*SO(KS)                                                    AQ  43
      GO TO 15                                                          AQ  44
C                                                                       AQ  45
   10 R   = SQRT( (YS(JR,IS)-ETAS2(JS))**2 + (ZY(JR,IS)-ZETAS(JS))**2 ) AQ  46
     1      *BETA                                                       AQ  47
      XMC = XS(JI,JR,IS) - R                                            AQ  48
      Y4  = ETAB2(JS)*SO(KS)                                            AQ  49
C                                                                       AQ  50
      IF ( JS .LE. NS3 .AND. IS .EQ. KS ) GO TO 15                      AQ  51
      BY  = BETABO(JS,KS)                                               AQ  52
      XLE = XISLTE(1,JS,KS)                                             AQ  53
      XTE = XISLTE(2,JS,KS)                                             AQ  54
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AQ  55
      GO TO 20                                                          AQ  56
C                                                                       AQ  57
   15 IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AQ  58
C                                                                       AQ  59
      CALL XMBY ( XM, BY, Y4, BRPT(1,1,KS), NEND(KS) )                  AQ  60
C                                                                       AQ  61
      XLE = ( XM - BY )*BRINV + XV(KS)                                  AQ  62
      XTE = ( XM + BY )*BRINV + XV(KS)                                  AQ  63
      BY  = BY*BRINV                                                    AQ  64
C                                                                       AQ  65
   20 IF ( XMC .GT. XLE ) GO TO 30                                      AQ  66
      P3 = 0.0                                                          AQ  67
      GO TO 1000                                                        AQ  68
C                                                                       AQ  69
C     P3 IS SET TO ZERO IF THE MACH CONE IS FORWARD OF THE LEADING EDGE.AQ  70
C                                                                       AQ  71
   30 IF ( XMC .LT. XTE ) GO TO 100                                     AQ  72
      IF ( JJ .NE. NJ(KS) ) GO TO 101                                   AQ  73
      IF ( IS .EQ. KS .OR. JS .EQ. 62 ) GO TO 101                       AQ  74
C                                                                       AQ  75
      DO 40 J=1,JJ                                                      AQ  76
      XICT(J) = XIBAR(J,KS)                                             AQ  77
      XIB2(J) = XIBAR(J,KS)                                             AQ  78
   40 XIS2(J) = XIS(J,JS,KS)                                            AQ  79
C                                                                       AQ  80
      CALL CHDTSS ( W1, XIB2, XIB2, JJ, ICHORD(KS), LSPAN(KS), IND, 0,  AQ  81
     1              XMACH, BRPT(1,1,KS), Y4, JSUROP )                   AQ  82
C                                                                       AQ  83
   60 P3 = PI/JJ                                                        AQ  84
      IF ( IXI(KS) .NE. 2 ) P3 = 2.0*PI/( 2.0*JJ + 1.0 )                AQ  85
      GO TO 1000                                                        AQ  86
C                                                                       AQ  87
  100 XTE = XMC                                                         AQ  88
  101 XM2 = 0.5*( XTE + XLE )                                           AQ  89
      BY2 = 0.5*( XTE - XLE )                                           AQ  90
      BRAT = BY2/BY                                                     AQ  91
C                                                                       AQ  92
      IF ( IS .EQ. KS .OR. JJ .NE. NJ(KS) ) GO TO 200                   AQ  93
C                                                                       AQ  94
  105 DO 110 J=1,JJ                                                     AQ  95
      XICT(J) = XIBAR(J,KS)                                             AQ  96
      XIB2(J) = BRAT*( 1.0 + XIBAR(J,KS) ) - 1.0                        AQ  97
  110 XIS2(J) = XM2 + BY2*XIBAR(J,KS)                                   AQ  98
C                                                                       AQ  99
      CALL CHDTSS ( W1, XIB2, XIBAR(1,KS), JJ, ICHORD(KS), LSPAN(KS),   AQ 100
     1              IND, 0, XMACH, BRPT(1,1,KS), Y4, JSUROP )           AQ 101
C                                                                       AQ 102
      GO TO 60                                                          AQ 103
C                                                                       AQ 104
  200 P3 = PI/JJ                                                        AQ 105
C                                                                       AQ 106
      DO 210 J=1,JJ                                                     AQ 107
      XIB2(J) = BRAT*( 1.0 + XICT(J) ) - 1.0                            AQ 108
  210 XIS2(J) = XM2 + BY2*XICT(J)                                       AQ 109
C                                                                       AQ 110
      CALL CHDTSS ( W1, XIB2, XICT, JJ, ICHORD(KS), LSPAN(KS), IND, 0,  AQ 111
     1              XMACH, BRPT(1,1,KS), Y4, JSUROP )                   AQ 112
C                                                                       AQ 113
      GO TO 1000                                                        AQ 114
C                                                                       AQ 115
  500 Y4  = Y*SO(KS)                                                    AQ 116
      IF ( JS .NE. 62 ) Y4 = ETAB2(JS)*SO(KS)                           AQ 117
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AQ 118
C                                                                       AQ 119
      CALL XMBY ( XM, BY, Y4, BRPT(1,1,KS), NEND(KS) )                  AQ 120
C                                                                       AQ 121
      BY  = BY*BRINV                                                    AQ 122
      XM  = XM*BRINV + XV(KS)                                           AQ 123
C                                                                       AQ 124
      DO 510 J=1,JJ                                                     AQ 125
  510 XIS2(J) = XM + XICT(J)*BY                                         AQ 126
C                                                                       AQ 127
 1000 IF ( BRAT .NE. 0.0 ) P3 = P3*BRAT                                 AQ 128
      IF ( JSUROP .NE. 0 ) P3 = P3*BREF*BY/SO(KS)                       AQ 129
      YQ(1) = XLE                                                       AQ 130
      YQ(2) = BY                                                        AQ 131
      YQ(3) = Y4                                                        AQ 132
      RETURN                                                            AQ 133
      END                                                               AQ 134
      SUBROUTINE TKERNS ( CK, XMACH, JJ, NS2, X, Y, Z, COSP, SINP, SIG, AR   1
     1                    XI, ETA, ZETA, COSQ, SINQ )                   AR   2
C                                                                       AR   3
C     SUBROUTINE TO COMPUTE THE PLANAR OR NONPLANAR SUBSONIC OR         AR   4
C     SUPERSONIC KERNEL FUNCTION FOR STEADY TRANSONIC FLOW.             AR   5
C                                                                       AR   6
      DIMENSION CK(15,31), XI(15,31), ETA(61), ZETA(61), SIG(61)        AR   7
C                                                                       AR   8
      BETA2 = 1.0 - XMACH*XMACH                                         AR   9
C                                                                       AR  10
      IF ( ABS(Z-ZETA(1)) .GT. ABS(Y-ETA(1))*0.01 ) GO TO 100           AR  11
      IF ( ABS(SINP-SINQ) .GT. ABS(COSP+COSQ)*0.005 ) GO TO 100         AR  12
C                                                                       AR  13
      IF ( XMACH .LT. 1.0 ) GO TO 20                                    AR  14
C                                                                       AR  15
      Y0 = Y - ETA(1)                                                   AR  16
      Y2 = Y0*Y0                                                        AR  17
      DO 10 J=1,JJ                                                      AR  18
      X0 = X - XI(J,1)                                                  AR  19
   10 CK(J,1) = -2.*X0/( Y2*SQRT( X0*X0 + BETA2*Y2 ) )                  AR  20
      GO TO 300                                                         AR  21
C                                                                       AR  22
   20 DO 30 I=1,NS2                                                     AR  23
      Y0 = Y - ETA(I)                                                   AR  24
      Y2 = Y0*Y0                                                        AR  25
      DO 30 J=1,JJ                                                      AR  26
      X0 = X - XI(J,I)                                                  AR  27
   30 CK(J,I) = - ( 1.0 + X0/SQRT( X0*X0 + BETA2*Y2 ) )/Y2              AR  28
      GO TO 300                                                         AR  29
C                                                                       AR  30
  100 T1 = COSP*COSQ + SINP*SINQ                                        AR  31
C                                                                       AR  32
      IF ( XMACH .LT. 1.0 ) GO TO 150                                   AR  33
C                                                                       AR  34
      Y0 = Y - ETA(1)                                                   AR  35
      Z0 = Z - ZETA(1)                                                  AR  36
      T2 = ( Z0*COSP - Y0*SINP )*( Z0*COSQ - Y0*SINQ )                  AR  37
      R2 = Y0*Y0 + Z0*Z0                                                AR  38
      OR2 = 1.0/R2                                                      AR  39
C                                                                       AR  40
      DO 110 J=1,JJ                                                     AR  41
      X0 = X - XI(J,1)                                                  AR  42
      RR2= 1.0/( X0*X0 + BETA2*R2 )                                     AR  43
      RR = SQRT( RR2 )                                                  AR  44
      CK1= 2.0*X0*RR                                                    AR  45
C                                                                       AR  46
  110 CK(J,1) = -OR2*CK1*( T1 - T2*( 2.0*OR2 + BETA2*RR2 ) )            AR  47
      GO TO 300                                                         AR  48
C                                                                       AR  49
  150 NS  = NS2                                                         AR  50
      NS1 = 1                                                           AR  51
      NS3 = NS2/2                                                       AR  52
      COSQ2 = COSQ                                                      AR  53
      SINQ2 = SINQ                                                      AR  54
  160 DO 170 JS=NS1,NS                                                  AR  55
      Y0  = Y - ETA(JS)                                                 AR  56
      Z0  = Z - ZETA(JS)                                                AR  57
      T2  = ( Z0*COSP - Y0*SINP )*( Z0*COSQ2 - Y0*SINQ2 )               AR  58
      R2  = Y0*Y0 + Z0*Z0                                               AR  59
      OR2 = 1.0/R2                                                      AR  60
C                                                                       AR  61
      DO 170 J=1,JJ                                                     AR  62
      X0  = X - XI(J,JS)                                                AR  63
      RR2 = 1.0/( X0*X0 + BETA2*R2 )                                    AR  64
      RR  = SQRT( RR2 )                                                 AR  65
      CK1 = 1.0 + X0*RR                                                 AR  66
C                                                                       AR  67
  170 CK(J,JS) = -OR2*( T1*CK1 - T2*( 2*OR2*CK1 + BETA2*X0*RR*RR2 ) )   AR  68
      IF ( NS .EQ. NS2 ) GO TO 300                                      AR  69
C                                                                       AR  70
      NS1 = NS + 1                                                      AR  71
      NS  = NS2                                                         AR  72
      COSQ2 = -COSQ                                                     AR  73
      T1    = -COSP*COSQ + SINP*SINQ                                    AR  74
      GO TO 160                                                         AR  75
C                                                                       AR  76
  300 RETURN                                                            AR  77
      END                                                               AR  78
      SUBROUTINE GEOMTS ( JR, IS, KS, NS2, NS3, JS1, JS2, YV2, ZV2,     AS   1
     1                       CKSS, SKSS, LSPA, ISTP )                   AS   2
C                                                                       AS   3
C     SUBROUTINE TO CALCULATE THE TRANSFORMED SPANWISE INTEGRATION      AS   4
C     POINT ARRAY FOR IS .EQ. KS.                                       AS   5
C     IF IS .NE. KS, THE ARRAYS ARE SET UP BUT NO TRANSFORMATION IS     AS   6
C     PERFORMED.                                                        AS   7
C                                                                       AS   8
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AS   9
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AS  10
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AS  11
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AS  12
C                                                                       AS  13
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AS  14
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AS  15
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AS  16
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AS  17
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AS  18
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AS  19
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AS  20
C                                                                       AS  21
      COMMON /FUNCT/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AS  22
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AS  23
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AS  24
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AS  25
C                                                                       AS  26
      NR2  = NS(KS)                                                     AS  27
      IF ( IS .NE. KS ) GO TO 45                                        AS  28
C                                                                       AS  29
      DO 10 JS=1,NS3                                                    AS  30
      IF ( Y .LT. ETABAR(JS,KS) ) GO TO 20                              AS  31
   10 CONTINUE                                                          AS  32
C                                                                       AS  33
   20 JS1 = NS3 + 1 - JS                                                AS  34
      JS2 = JS1 + 1                                                     AS  35
C                                                                       AS  36
      DO 25 JS=1,JS1                                                    AS  37
      ETAB2(JS) = Y + ETABAR(JS,KS) + 1.0                               AS  38
      ETAS2(JS) = YV2 + ETAB2(JS)*CKSS                                  AS  39
      ZETAS(JS) = ZV2 + ETAB2(JS)*SKSS                                  AS  40
   25 SIGS(JS)  = SIGETA(JS,KS)                                         AS  41
C                                                                       AS  42
      DO 30 JS=JS2,NS3                                                  AS  43
      ETAB2(JS) = Y + ETABAR(JS,KS) - 1.0                               AS  44
      ETAS2(JS) = YV2 + ETAB2(JS)*CKSS                                  AS  45
      ZETAS(JS) = ZV2 + ETAB2(JS)*SKSS                                  AS  46
   30 SIGS(JS)  = SIGETA(JS,KS)                                         AS  47
C                                                                       AS  48
      IF ( ISTYPE(KS) .NE. 3 ) GO TO 50                                 AS  49
C                                                                       AS  50
      NS3P1 = NS3 + 1                                                   AS  51
   35 DO 40 JS=NS3P1,NS2                                                AS  52
      ETAB2(JS) = ETABAR(JS,KS)                                         AS  53
      ETAS2(JS) = ETAS(JS,KS)                                           AS  54
      ZETAS(JS) = ZETA(JS,KS)                                           AS  55
   40 SIGS(JS)  = SIGETA(JS,KS)                                         AS  56
      IF ( IS - KS ) 100, 50, 100                                       AS  57
C                                                                       AS  58
   45 NS3P1 = 1                                                         AS  59
      GO TO 35                                                          AS  60
C                                                                       AS  61
   50 CALL UNETA ( UN, ETAB2, NS2, NR2, LSYM(KS), ISTP, LSPA )          AS  62
C                                                                       AS  63
      IF ( LSPA .NE. 1 ) GO TO 60                                       AS  64
C                                                                       AS  65
      DO 55 JS=1,NS2                                                    AS  66
      SY2(JS) = SQRT( 1.0 - ETABAR(JS,KS)**2 )                          AS  67
      SETA    = SY2(JS)*SQRT( 1.0 - ETAB2(JS)**2 )                      AS  68
      DO 55 JNU=1,NR2                                                   AS  69
   55 UN(JNU,JS) = UN(JNU,JS)*SETA                                      AS  70
      GO TO 100                                                         AS  71
C                                                                       AS  72
   60 CALL WEIGHT ( SY2(1), ETABAR(1,KS), NS3, A, A(71) )               AS  73
C                                                                       AS  74
      IF ( NS3 .NE. NS2 )                                               AS  75
     1CALL WEIGHT ( SY2(NS3+1), ETABAR(NS3+1,KS), NS3, A, A(71) )       AS  76
C                                                                       AS  77
      DO 65 JS=1,NS2                                                    AS  78
      DO 65 JNU=1,NR2                                                   AS  79
   65 UN(JNU,JS) = UN(JNU,JS)*SY2(JS)                                   AS  80
C                                                                       AS  81
  100 RETURN                                                            AS  82
      END                                                               AS  83
      OVERLAY(COMPTY,3,4)                                               AT   1
      PROGRAM    TRANUN                                                 AT   2
C                                                                       AT   3
C     SUBROUTINE TO CALCULATE THE AERODYNAMIC MATRIX FOR MULTIPLE       AT   4
C     ARBITRARY SURFACES OSCILLATING IN SUBSONIC, MIXED TRANSONIC       AT   5
C     OR SUPERSONIC FLOW.                                               AT   6
C                                                                       AT   7
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AT   8
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AT   9
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AT  10
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AT  11
C                                                                       AT  12
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AT  13
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AT  14
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AT  15
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AT  16
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AT  17
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AT  18
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AT  19
C                                                                       AT  20
      COMMON /UNFUN/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AT  21
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AT  22
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AT  23
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AT  24
C                                                                       AT  25
      COMMON /GAMA/ GAMMA                                               AT  26
      COMMON /KERNL/  GJMU(15,31), CKERNL(67)                           AT  27
      COMPLEX GETA, GYY, HPSI, CKERNL, ACOEF, D, GJMU, RK3              AT  28
      COMPLEX EK, CONST, CKER                                           AT  29
      DIMENSION ACOEF(70), D(20)                                        AT  30
      DIMENSION EK(31), GMACHP(31), GMACHM(31)                          AT  31
C                                                                       AT  32
      EQUIVALENCE ( ACOEF(1), A(1) )                                    AT  33
      EQUIVALENCE ( EK(1), B( 1) ), ( GMACHP(1), B(65) ),               AT  34
     1                              ( GMACHM(1), B(96) )                AT  35
C                                                                       AT  36
      NK1 = 1                                                           AT  37
      IF ( RK(1) .LE. FREQ ) NK1 = 2                                    AT  38
      DO 5000 IK=NK1,NK                                                 AT  39
      KR = 0                                                            AT  40
      DO 4000 IS=1,NSURF                                                AT  41
C                                                                       AT  42
      IF ( IS .EQ. 1 ) GO TO 1                                          AT  43
C                                                                       AT  44
      KR = KR + NW2(IS-1)                                               AT  45
      IF ( KSURF(IS-1,IS-1) .LT. 0 ) KR = KR + NS(IS-1)                 AT  46
C                                                                       AT  47
    1 MBAR = NC(IS)                                                     AT  48
      NR   = NS(IS)                                                     AT  49
C                                                                       AT  50
      DO 4000 KS=1,NSURF                                                AT  51
C                                                                       AT  52
      IF ( JSUROP .NE. 0 ) GO TO 6000                                   AT  53
C                                                                       AT  54
      ISTP = ISTYPE(KS)                                                 AT  55
      LSPA = LSPAN(KS)                                                  AT  56
      ICHD = ICHORD(KS)                                                 AT  57
      GO TO 6001                                                        AT  58
C                                                                       AT  59
 6000 LSPA = 5                                                          AT  60
      ISTP = 3                                                          AT  61
      IF ( ISTYPE(KS) .EQ. 4 ) ISTP = 4                                 AT  62
      ICHD = 1                                                          AT  63
C                                                                       AT  64
 6001 IF ( IDUMP .NE. 0 ) WRITE (6,5) IS, KS                            AT  65
    5 FORMAT (1H1,13X," THE DOWNWASH MATRIX FOR THE DOWNWASH INDUCED "  AT  66
     1  ,/,       20X," ON SURFACE ", I2,", BY SURFACE ",I2,// )        AT  67
      IF ( IS .EQ. KS ) GO TO 6                                         AT  68
C                                                                       AT  69
      IF ( KSURF(IS,KS) .GE. 0 ) GO TO 6                                AT  70
      MUNU = NW2(KS)                                                    AT  71
      IF ( KSURF(KS,KS) .LT. 0 ) MUNU = MUNU + NS(KS)                   AT  72
      N = NW2(IS) + KR                                                  AT  73
      IF ( KSURF(IS,IS) .LT. 0 ) N = N + NS(IS)                         AT  74
C                                                                       AT  75
      KRP1 = KR + 1                                                     AT  76
      DO 3 IR=KRP1,N                                                    AT  77
      DO 2 I =1,MUNU                                                    AT  78
    2 ACOEF(I) = 0.0                                                    AT  79
      WRITE (1) ( ACOEF(I), I=1,MUNU )                                  AT  80
      IF ( IDUMP .NE. 0 ) WRITE (6,2700) IR, (ACOEF(I),I=1,MUNU)        AT  81
    3 CONTINUE                                                          AT  82
      GO TO 4000                                                        AT  83
C                                                                       AT  84
    6 IR = KR                                                           AT  85
      SOBR = SO(KS)*BRINV                                               AT  86
      IF ( ISTYPE(KS) .GT. 2 ) SOBR = 0.5*SOBR                          AT  87
      NS2  = NSI(KS)                                                    AT  88
      JJ   = NJ(KS)                                                     AT  89
      JJMIN= 4                                                          AT  90
      NR2  = NS(KS)                                                     AT  91
      MBAR2= NC(KS)                                                     AT  92
      NS3  = NS2                                                        AT  93
      IF ( ISTYPE(KS) .EQ. 3 ) NS3 = NS2/2                              AT  94
C                                                                       AT  95
      COSKS = COS( THETA(KS) )                                          AT  96
      SINKS = SIN( THETA(KS) )                                          AT  97
      IF ( ABS( COSKS ) .LT. 1.0 E-5 ) COSKS = 0.0                      AT  98
      IF ( ABS( SINKS ) .LT. 1.0 E-5 ) SINKS = 0.0                      AT  99
C                                                                       AT 100
      P2 = 2.0*PI*PI/( (2*JJ+1)*NS3 )                                   AT 101
      IF ( IXI(KS) .EQ. 2 ) P2 = PI*PI/( JJ*NS3 )                       AT 102
      P3 = P2*NS3/PI                                                    AT 103
C                                                                       AT 104
      IF ( IS .EQ. KS ) GO TO 20                                        AT 105
C                                                                       AT 106
      CALL UNETA ( UN, ETABAR(1,KS), NS2, NR2, LSYM(KS), ISTP, LSPA )   AT 107
C                                                                       AT 108
      IF ( LSPA .NE. 1 ) GO TO 12                                       AT 109
C                                                                       AT 110
      DO 10 JS=1,NS2                                                    AT 111
      SETA    = 1.0 - ETABAR(JS,KS)**2                                  AT 112
      SY2(JS) = SQRT( SETA )                                            AT 113
      DO 10 JNU=1,NR2                                                   AT 114
   10 UN(JNU,JS) = UN(JNU,JS)*SETA                                      AT 115
      GO TO 20                                                          AT 116
C                                                                       AT 117
   12 CALL WEIGHT ( SY2(1), ETABAR(1,KS), NS3, A, A(71) )               AT 118
C                                                                       AT 119
      IF ( NS3 .NE. NS2 ) CALL WEIGHT ( SY2(NS3+1), ETABAR(NS3+1,KS),   AT 120
     1                                  NS3, A, A(71) )                 AT 121
C                                                                       AT 122
      DO 14 JS=1,NS2                                                    AT 123
      DO 14 JNU=1,NR2                                                   AT 124
   14 UN(JNU,JS) = UN(JNU,JS)*SY2(JS)                                   AT 125
C                                                                       AT 126
   20 ICH = 1                                                           AT 127
      JS1 = NS3                                                         AT 128
      JS2 = 1                                                           AT 129
C                                                                       AT 130
      YV2 = YV(KS)                                                      AT 131
      ZV2 = ZV(KS)                                                      AT 132
      IF ( ISTYPE(KS) .LT. 3 ) GO TO 22                                 AT 133
      YV2 = YV2 + SOBR*COSKS                                            AT 134
      ZV2 = ZV2 + SOBR*SINKS                                            AT 135
C                                                                       AT 136
   22 DO 3000 JR=1,NR                                                   AT 137
C                                                                       AT 138
      JUMP = 1                                                          AT 139
      IF ( IS .NE. KS ) GO TO 24                                        AT 140
C                                                                       AT 141
      Y = YBAR(JR,IS)                                                   AT 142
      Z = 0.0                                                           AT 143
      DTHETA = 0.0                                                      AT 144
      GO TO 25                                                          AT 145
C                                                                       AT 146
   24 CALL TRANSF ( THETA(KS), YV2, ZV2, YS(JR,IS), ZY(JR,IS), Y, Z )   AT 147
C                                                                       AT 148
      Y = Y/SOBR                                                        AT 149
      Z = Z/SOBR                                                        AT 150
      IF ( SO(IS) .EQ. SO(KS) .AND. NS(IS) .EQ. NS(KS) ) GO TO 23       AT 1501
      Z2 = 0.01*( 1.0 - ABS(Y) )                                        AT 151
      IF ( ABS(Z ) .LT. Z2 ) Z = SIGN( Z2, Z )                          AT 152
   23 DTHETA = THETA(IS) - THETA(KS)                                    AT 153
C                                                                       AT 154
      IF ( KSURF(IS,KS) .EQ. 0 ) GO TO 30                               AT 155
      IF ( ABS(Y) .GT. 0.999   ) GO TO 30                               AT 156
C                                                                       AT 157
      JUMP = 0                                                          AT 158
      Y3 = Y + 0.001                                                    AT 159
      CALL UNETA ( DUNY, Y3, 1, NR2, LSYM(KS), ISTP, LSPA )             AT 160
C                                                                       AT 161
      CALL LOGSNG ( TL1, TL2, Y, Z, ETAB2, NS3, SY2, DTHETA, 1.0 )      AT 162
C                                                                       AT 163
   25 CALL UNETA ( UNY,  Y,  1, NR2, LSYM(KS), ISTP, LSPA )             AT 164
C                                                                       AT 165
   30 CALL GEOMTU ( JR, IS, KS, NS2, NS3, JS1, JS2, YV2, ZV2,           AT 166
     1              COSKS*SOBR, SINKS*SOBR, LSPA, ISTP )                AT 167
C                                                                       AT 168
      IF ( ABS(Y) .LT. 0.999 ) Y2 = SQRT( 1.0 - Y*Y )                   AT 169
C                                                                       AT 170
      IF ( JUMP .NE. 0 ) GO TO 60                                       AT 171
C                                                                       AT 172
      DO 55 I=1,NR2                                                     AT 173
   55 DUNY(I) = 1000.0*( DUNY(I) - UNY(I) )                             AT 174
C                                                                       AT 175
   60 SIGQ = SIGS(1) + 1.0                                              AT 176
      COSP = COS( SIGY(JR,IS) )                                         AT 177
      SINP = SIN( SIGY(JR,IS) )                                         AT 178
      IF ( ABS(COSP) .LT. 1.0 E-5 ) COSP = 0.0                          AT 179
      IF ( ABS(SINP) .LT. 1.0 E-5 ) SINP = 0.0                          AT 180
C                                                                       AT 181
      DO 3000 JI=1,MBAR                                                 AT 182
C                                                                       AT 183
      Y5 = YBAR(JR,IS)                                                  AT 184
      IF ( ISTYPE(IS) .LT. 3 ) Y5 = 2*Y5 - 1.0                          AT 185
      GMACH = XMACH                                                     AT 186
C                                                                       AT 187
      IF ( ITRANS(IS) .NE. 0 )                                          AT 188
     1CALL CALCM ( XBAR(JI,IS), Y5, MBAR, NR, BMACH(1,IS), GMACH,       AT 189
     1             D(1), D(12) )                                        AT 190
C                                                                       AT 191
      JJ = NJ(KS)                                                       AT 192
      IR = IR + 1                                                       AT 193
      BETA2 = 1.0 - GMACH**2                                            AT 194
      BETA  = SQRT( ABS( BETA2 ) )                                      AT 195
      RK2 = RK(IK)*XMACH/GMACH                                          AT 196
C                                                                       AT 197
      IF ( JUMP .NE. 0 .AND. IS .NE. KS ) GO TO 250                     AT 198
      ETAA = -1.0                                                       AT 199
      ETAB =  1.0                                                       AT 200
      IF ( GMACH .LT. 1.0 ) GO TO 240                                   AT 201
C                                                                       AT 202
      SLE = ( BRPT(1,3,KS) - BRPT(1,1,KS) )/SO(KS)                      AT 203
      YP  = Y*SOBR                                                      AT 204
      IF ( ISTYPE(KS) .GT. 1 ) YP = YP + SOBR                           AT 205
      XXLE = (XS(JI,JR,IS) - ( XV(KS) - BO(KS)*BRINV + YP*SLE ) )/SOBR  AT 206
C                                                                       AT 207
      CALL ETALIM ( ETAA, ETAB, SLE, BETA, XXLE, Y, Z )                 AT 208
C                                                                       AT 209
  240 CALL PLNTRM ( T1, T2, T3, Y, Z, DTHETA, ETAB2, LSPA, NS3, SY2,    AT 210
     1              ETAA, ETAB )                                        AT 211
C                                                                       AT 212
  250 JS3 = 0                                                           AT 213
      DELT = 1.0 - ABS( YBAR(1,IS) )                                    AT 214
  201 DO 200 JS=1,NS2                                                   AT 215
      MULT = 1                                                          AT 216
      IF ( ABS( ETAB2(JS) - Y ) .LT. DELT .OR. JS3 .EQ. 62 ) MULT = 3   AT 217
C                                                                       AT 218
      IF ( GMACH .GE. 1.0 ) GO TO 70                                    AT 219
C                                                                       AT 220
      IF ( MULT .NE. 1 ) GO TO 62                                       AT 221
C                                                                       AT 222
      JJ = NJ(KS)                                                       AT 223
      DO 61 J=1,JJ                                                      AT 224
   61 XICT(J) = XIBAR(J,KS)                                             AT 225
      GO TO 64                                                          AT 226
C                                                                       AT 227
   62 JJ = NJ(KS)*MULT                                                  AT 228
      IF ( IXI(KS) .NE. 2 ) JJ = JJ + 1                                 AT 229
      P2 = PI/(2*JJ+1)                                                  AT 230
      IF ( IXI(KS) .EQ. 2 ) P2 = PI/(2*JJ)                              AT 231
      DO 63 J=1,JJ                                                      AT 232
   63 XICT(J) = -COS( (2*J-1)*P2 )                                      AT 233
C                                                                       AT 234
   64 P3 = PI/JJ                                                        AT 235
      IF ( IXI(KS) .NE. 2 ) P3 = 2.0*PI/( 2*JJ+1.0 )                    AT 236
C                                                                       AT 237
      CALL TNXI ( TN, XICT, JJ, MBAR2, ICHD )                           AT 238
      IF ( JSUROP .NE. 0 ) GO TO 100                                    AT 239
C                                                                       AT 240
      DO 65 J=1,JJ                                                      AT 241
      Z3 = 1.0 - XICT(J)                                                AT 242
      DO 65 JMU=1,MBAR2                                                 AT 243
      W1(J) = 1.0                                                       AT 244
   65 TN(JMU,J) = TN(JMU,J)*Z3                                          AT 245
      GO TO 100                                                         AT 246
C                                                                       AT 247
   70 IF ( IS .NE. KS ) GO TO 100                                       AT 248
C                                                                       AT 249
      JJ = ( JJMIN + JI )*MULT                                          AT 250
      NJ3 = JJ                                                          AT 251
      P2  = PI/( 2*NJ3 )                                                AT 252
      DO 80 J=1,NJ3                                                     AT 253
   80 XICT(J) = -COS( (2*J-1)*P2 )                                      AT 254
C                                                                       AT 255
  100 IF ( JS3 .EQ. 62 ) GO TO 202                                      AT 256
C                                                                       AT 257
C                                                                       AT 258
      CALL TUNGEO ( JR, JI, JJ, JS, P3, NS3, IS, KS, COSKS, COSKS2, IR )AT 259
C                                                                       AT 260
      IF ( P3 .NE. 0.0 ) GO TO 110                                      AT 261
C                                                                       AT 262
      DO 105 JMU=1,MBAR2                                                AT 263
  105 GJMU(JMU,JS) = 0.0                                                AT 264
      GO TO 200                                                         AT 265
C                                                                       AT 266
  110 CALL TKERNU ( CKERNL,       GMACH, JJ, 1, RK2,                    AT 267
     1     XS(JI,JR,IS), YS(JR,IS), ZY(JR,IS), COSP, SINP, SIGS(JS),    AT 268
     2     XIS2, ETAS2(JS), ZETAS(JS), COSKS , SINKS )                  AT 269
C                                                                       AT 270
      IF ( GMACH .GE. 1.0 ) CALL TNXI ( TN, XIB2, JJ, MBAR2, +1 )       AT 271
C                                                                       AT 272
  120 CALL TUNPSI ( JR, JI, IS, KS, JS, P3, JJ, MBAR2, NS3, IR,         AT 273
     1              COSP, SINP, COSKS, SINKS, RK2 )                     AT 274
      DO 130 JMU=1,MBAR2                                                AT 275
      GETA(JMU) =  HPSI(JMU,1)                                          AT 276
      DO 130 J=1,JJ                                                     AT 277
  130 GETA(JMU) = GETA(JMU) + ( TN(JMU,J)*W1(J) )*CKERNL(J)             AT 278
C                                                                       AT 279
      DO 140 KMU=1,MBAR2                                                AT 280
  140 GJMU(KMU,JS) = GETA(KMU)*P3                                       AT 281
C                                                                       AT 282
  200 CONTINUE                                                          AT 283
C                                                                       AT 284
      IF ( JUMP .NE. 0 .AND. IS .NE. KS ) GO TO 210                     AT 285
C                                                                       AT 286
      JS3 = 62                                                          AT 287
      GO TO 201                                                         AT 288
C                                                                       AT 289
  202 CALL TUNGEO ( JR, JI, JJ, 62, P3, NS3, IS, KS,                    AT 290
     1              COSKS, COSKS2, IR )                                 AT 291
C                                                                       AT 292
      IF ( P3 .EQ. 0 ) GO TO 210                                        AT 293
C                                                                       AT 294
      CALL TUNPSI ( JR, JI, IS, KS, 62, P3, JJ, MBAR2, NS3, IR,         AT 295
     1              COSP, SINP, COSKS, SINKS, RK2 )                     AT 296
C                                                                       AT 297
  210 MUNU = 0                                                          AT 298
      Y4 = Y*SO(KS)                                                     AT 299
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AT 300
C                                                                       AT 301
      DO 2000 JMU=1,MBAR2                                               AT 302
      DO 2000 JNU=1,NR2                                                 AT 303
      MUNU = MUNU + 1                                                   AT 304
C                                                                       AT 305
C     CALCULATION OF THE DOUBLE INTEGRALS WITH THE CHORDWISE            AT 306
C     INTEGRALS FROM AB0VE CONTAINED IN ARRAY GJMU(JMU,JS).             AT 307
C                                                                       AT 308
      D(1) = 0.0                                                        AT 309
      DO 300 JS=1,NS2                                                   AT 310
      GETA(JS) = GJMU(JMU,JS)*UN(JNU,JS)                                AT 311
  300 D(1) = D(1) + GETA(JS)                                            AT 312
      D(1) = D(1)*(SOBR**2)*PI/NS3                                      AT 313
C                                                                       AT 314
      IF ( IS .NE. KS ) GO TO 400                                       AT 315
      IF ( JNU .GT. 1 ) GO TO 310                                       AT 316
C                                                                       AT 317
*     WRITE (6,2223) D(1), ( GETA(JS), JS=1,NS2 )                       AT 318
 2223 FORMAT (1H ,/," D(1)= ",2E14.7," GETA = ",//, (10E12.4) )         AT 319
      IF ( GMACH .GE. 1.0 ) GO TO 301                                   AT 320
      D(2) = HPSI(JMU,1)*2.0*P3                                         AT 321
C                                                                       AT 322
C     D(2) IS THE CORRECTED DOWNWASH CHORD INTEGRAL COMPUTED            AT 323
C     AS HPSI(JMU,62) IN TSTPSI.                                        AT 324
C                                                                       AT 325
      IF ( LSPAN(IS) .EQ. 1 ) D(2) = D(2)*Y2                            AT 326
 301  M1 = NS3                                                          AT 327
      M2 = 1                                                            AT 328
      RK3 = CMPLX( 0.0, RK2*BYBO(JR,IS) )                               AT 329
      ETA1 = ETAB2(M1) - YBAR(JR,IS)                                    AT 330
      ETA2 = ETAB2(M2) - YBAR(JR,IS)                                    AT 331
      S1   = ( (ETA1*SOBR)**2 )/SY2(M1)                                 AT 332
      S2   = ( (ETA2*SOBR)**2 )/SY2(M2)                                 AT 333
      IF ( GMACH .LT. 1.0 ) GO TO 310                                   AT 334
C                                                                       AT 335
      ETA4  = ETAB2(M2+1) - YBAR(JR,IS)                                 AT 336
      Y1Y2  = ( ETA4/ETA1 )**2                                          AT 337
      QC(1) = ( (ETA4*SOBR)**2 )/SY2(M1-1)                              AT 338
      QC(2) = S1                                                        AT 339
      QC(3) = S2                                                        AT 340
      QC(4) = ( (ETA4*SOBR)**2 )/SY2(M2+1)                              AT 341
C                                                                       AT 342
      D(2) = -( GETA(M1-1)*QC(1) + GETA(M2+1)*QC(4) - ( GETA(M1)*QC(2)  AT 343
     1        + GETA(M2)*QC(3) )*Y1Y2 )/( 2*UNY(1)*( 1 - Y1Y2 ) )       AT 344
C                                                                       AT 345
      DELT1 = 0.0                                                       AT 346
      DELT2 = 0.0                                                       AT 347
  310 GYY   = D(2)*UNY(JNU)                                             AT 348
      D(11) = -GETA(M1)*S1                                              AT 349
      D(13) = -GETA(M2)*S2                                              AT 350
      D(12) = GYY                                                       AT 351
*     WRITE (6,2222) ( D(I), I=11,13 )                                  AT 352
 2222 FORMAT (1H ,/," D(JR-1,JR,JR+1) =", 3(2X,2E14.6) )                AT 353
C                                                                       AT 354
      D(20) = ( ( D(11) - D(12) ) - ( D(13) - D(12) )*ETA1/ETA2 )/      AT 355
     1          ( ETA1**2 - ETA1*ETA2 )                                 AT 356
      D(19) = ( D(11) - D(12) )/ETA1 - D(20)*ETA1                       AT 357
      D(18) = D(12)                                                     AT 358
C                                                                       AT 359
      D(1)  = D(1) - ( D(18)*T1 + D(19)*T2 + D(20)*T3 )                 AT 360
C                                                                       AT 361
      GO TO 500                                                         AT 362
C                                                                       AT 363
  400 IF ( JUMP .NE. 0 ) GO TO 500                                      AT 364
C                                                                       AT 365
      IF ( JNU .GT. 1 ) GO TO 410                                       AT 366
C                                                                       AT 367
      D(2) = HPSI(JMU,1)*2.0*P3                                         AT 368
C                                                                       AT 369
      IF ( JMU .GT. 1 ) GO TO 410                                       AT 370
C                                                                       AT 371
      Q1 = T1 + TL1*RK2*RK2                                             AT 372
      Q2 = T2 + TL2*RK2*RK2                                             AT 373
C                                                                       AT 374
      IF ( LSPAN(KS) .NE. 1 ) GO TO 410                                 AT 375
C                                                                       AT 376
      Q1 = Q1*Y2 - Q2*Y/Y2                                              AT 377
      Q2 = Q2*Y2                                                        AT 378
C                                                                       AT 379
  410 D(1) = D(1) - D(2)*( Q1*UNY(JNU) + Q2*DUNY(JNU) )                 AT 380
C                                                                       AT 381
  500 IF ( ISTYPE(KS) .GT. 2 ) D(1) = 2.0*D(1)                          AT 382
C                                                                       AT 383
 2000 ACOEF(MUNU) = D(1)*XMACH/GMACH                                    AT 384
C                                                                       AT 385
      IF ( KSURF(KS,KS) .GE. 0 ) GO TO 2600                             AT 386
C                                                                       AT 387
C     FOR THE KS'TH SURFACE TO BE THE SUBSONIC SURFACE OF A TRANSONIC   AT 388
C     PAIR, THE DOWNWASH DUE TO THE SH0CK LINE DOUBLET MUST BE          AT 389
C     CALCULATED ON THE IS'TH SURFACE. THIS IS PERFORMED IF             AT 390
C     KSURF(KS,KS) IS LT. ZERO.                                         AT 391
C                                                                       AT 392
      DO 2200 JS=1,NS2                                                  AT 393
C                                                                       AT 394
      IF ( JS .LE. NS3 .AND. IS .EQ. KS ) GO TO 2015                    AT 395
      BY  = BETABO(JS,KS)                                               AT 396
      XSH = XISLTE(1,JS,KS)                                             AT 397
      GO TO 2020                                                        AT 398
C                                                                       AT 399
 2015 Y5 = ETAB2(JS)*SO(KS)                                             AT 400
      IF ( ISTYPE(KS) .GT. 2 ) Y5 = 0.5*( Y5 + SO(KS) )                 AT 401
C                                                                       AT 402
      CALL XMBY ( XM, BY, Y5, BRPT(1,1,KS), NEND(KS) )                  AT 403
C                                                                       AT 404
      XSH = ( XM - BY )*BRINV + XV(KS)                                  AT 405
C                                                                       AT 406
 2020 IF ( GMACH .LT. 1.0 ) GO TO 2100                                  AT 407
C                                                                       AT 408
      R = SQRT( ( YS(JR,IS) - ETAS2(JS) )**2                            AT 409
     1        + ( ZY(JR,IS) - ZETAS(JS) )**2 )*BETA                     AT 410
      XMC = XS(JI,JR,IS) - R                                            AT 411
      IF ( XMC .GT. XSH ) GO TO 2100                                    AT 412
C                                                                       AT 413
      GJMU(1,JS) = 0.0                                                  AT 414
      GO TO 2200                                                        AT 415
C                                                                       AT 416
 2100 CALL TKERNU ( CKER, GMACH, 1, 1, RK2,                             AT 417
     1     XS(JI,JR,IS), YS(JR,IS), ZY(JR,IS), COSP, SINP, SIGS(JS),    AT 418
     2     XSH, ETAS2(JS), ZETAS(JS), COSKS, SINKS )                    AT 419
C                                                                       AT 420
      GJMU(1,JS) = CKER                                                 AT 421
C                                                                       AT 422
 2200 CONTINUE                                                          AT 423
C                                                                       AT 424
      IF ( JUMP .NE. 0 .AND. IS .NE. KS ) GO TO 2210                    AT 425
      CALL XMBY ( XM, BY, Y4, BRPT(1,1,KS), NEND(KS) )                  AT 426
      XSH = ( XM - BY )*BRINV + XV(KS)                                  AT 427
      D(2) = 2.0*CEXP( CMPLX( 0.0, RK2*(XSH-XS(JI,JR,IS)) ) )           AT 428
      IF ( IS .EQ. KS .AND. LSPAN(IS) .EQ. 1 ) D(2) = D(2)*Y2           AT 429
C                                                                       AT 430
 2210 DO 2500 JNU=1,NR2                                                 AT 431
      MUNU = MUNU + 1                                                   AT 432
      D(1) = 0.0                                                        AT 433
      DO 2250 JS=1,NS2                                                  AT 434
      GETA(JS) = GJMU(1,JS)*UN(JNU,JS)                                  AT 435
 2250 D(1) = D(1) + GETA(JS)                                            AT 436
      D(1) = D(1)*(SOBR**2)*AR(KS)*PI/NS3                               AT 437
C                                                                       AT 438
      IF ( IS .NE. KS ) GO TO 2300                                      AT 439
C                                                                       AT 440
      D(11) = -GETA(M1)*S1                                              AT 441
      D(12) = D(2)*UNY(JNU)                                             AT 442
      D(13) = -GETA(M2)*S2                                              AT 443
*     WRITE (6,2224) D(1), T1, T2, T3                                   AT 444
*     WRITE (6,2222) ( D(I), I=11,13 )                                  AT 445
 2224 FORMAT (/,"    D(1) = ",E14.7, "  T1,T2,T3 = ", 3E14.7    )       AT 446
C                                                                       AT 447
      D(20) = ( ( D(11) - D(12) ) - ( D(13) - D(12) )*ETA1/ETA2 )/      AT 448
     1          ( ETA1**2 - ETA1*ETA2 )                                 AT 449
      D(19) = ( D(11) - D(12) )/ETA1 - D(20)*ETA1                       AT 450
      D(18) = D(12)                                                     AT 451
C                                                                       AT 452
      D(1)  = D(1) - ( D(18)*T1 + D(19)*T2 + D(20)*T3 )*AR(KS)          AT 453
C                                                                       AT 454
      GO TO 2400                                                        AT 455
C                                                                       AT 456
 2300 IF ( JUMP .NE. 0 ) GO TO 2400                                     AT 457
C                                                                       AT 458
      D(1) = D(1) - D(2)*( Q1*UNY(JNU) + Q2*DUNY(JNU) )*AR(KS)          AT 459
C                                                                       AT 460
 2400 IF ( ISTYPE(KS) .GT. 2 ) D(1) = 2.0*D(1)                          AT 461
C                                                                       AT 462
 2500 ACOEF(MUNU) = D(1)*XMACH/( GMACH*SOBR )                           AT 463
C                                                                       AT 464
 2600 WRITE (1) ( ACOEF(I), I=1,MUNU )                                  AT 465
C                                                                       AT 466
      IF ( IDUMP .NE. 0 ) WRITE (6,2700) IR, ( ACOEF(I), I=1,MUNU )     AT 467
C                                                                       AT 468
 2700 FORMAT (/,9X,"A COEFFICIENTS FOR ROW ",I3, //, ( 3X, 5E15.7 ) )   AT 469
C                                                                       AT 470
 3000 CONTINUE                                                          AT 471
C                                                                       AT 472
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 4000                             AT 473
C                                                                       AT 474
C     THE PRESSURE AND POTENTIAL VALUES ACROSS THE SHOCK ARE CALCULATED AT 475
C     AT THE YBAR STATIONS FOR SATISFYING THE NORMAL SHOCK B.C.'S       AT 476
C      (PHIX+) - K*(PHI+)  + M(BAR)*(PHIX-) + K*(PHI-) = 0              AT 477
C                                                                       AT 478
C     THIS SECTION IS CURRENTLY RESTRICTED TO COPLANAR SURFACES FOR     AT 479
C     WHICH THE SPAN OF DOWNSTREAM SURFACES IS .LE. TO THOSE UPSTREAM.  AT 480
C                                                                       AT 481
      ZMBAR = ( GAMMA-1.0 + 2.0/((  XMACH)**2) )/( GAMMA+1.0 )          AT 482
C                                                                       AT 483
      RK3   = CMPLX( 0.0, RK(IK)*( 2.0*(GAMMA-1.0)/(GAMMA+1.0) ) )      AT 484
C                                                                       AT 485
C ***** NU = RK3 = I(RK2*(2(GAMMA-1)/(GAMMA+1))),GAMMA = 1.4            AT 486
C                                                                       AT 487
      DO 3500 JR=1,NR                                                   AT 488
C                                                                       AT 489
      IF ( IS .EQ. KS ) GO TO 3010                                      AT 490
C                                                                       AT 491
      DO 3005 I=1,MUNU                                                  AT 492
 3005 ACOEF(I) = 0.0                                                    AT 493
      IF( IABS( KSURF(KS,KS) ) .NE. IS ) GO TO 3450                     AT 494
C                                                                       AT 495
C                                                                       AT 496
      CALL TRANSF ( THETA(KS), YV2, ZV2, YS(JR,IS), ZY(JR,IS), Y5, Z )  AT 497
C                                                                       AT 498
      Y  = Y5/SOBR                                                      AT 499
      Z  =  Z/SOBR                                                      AT 500
      Z2 = 0.01*( 1.0 - ABS(Y) )                                        AT 501
      IF ( ABS(Z) .LT. Z2 ) Z = SIGN( Z2,Z )                            AT 502
      DTHETA = THETA(IS) - THETA(KS)                                    AT 503
      Y5 = Y5*BREF                                                      AT 504
      IF ( ISTYPE(KS) .GT. 2 ) Y5 = 0.5*( Y5 + SO(KS) )                 AT 505
C                                                                       AT 506
      CALL XMBY ( XM, BY, Y5, BRPT(1,1,KS), NEND(KS) )                  AT 507
      XSH = ( XM + BY )*BRINV + XV(KS)                                  AT 508
      GO TO 3020                                                        AT 509
C                                                                       AT 510
 3010 Y  = YBAR(JR,IS)                                                  AT 511
      Z  = 0.0                                                          AT 512
      BY = BYBO(JR,IS)                                                  AT 513
      XSH = XS(1,JR,IS) - ( XBAR(1,IS) - 1.0 )*BY                       AT 514
C                                                                       AT 515
 3020 CALL UNETA ( UNY, Y, 1, NR2, LSYM(KS), ISTYPE(KS), LSPAN(KS) )    AT 516
C                                                                       AT 517
      Y2 = -SQRT( 1.0 - Y*Y )                                           AT 518
C                                                                       AT 519
C                                                                       AT 520
      YB = YBAR(JR,IS)                                                  AT 521
      IF ( ISTYPE(IS) .LT. 3 ) YB = 2*YB - 1.0                          AT 522
C                                                                       AT 523
      CALL CALCM ( -1.0, YB, MBAR, NR, BMACH(1,IS), PHIP, D(1), D(12) ) AT 524
      CALL CALCM ( -.99, YB, MBAR, NR, BMACH(1,IS), PHIPX,D(1), D(12) ) AT 525
      GMACHP(JR) =  PHIP                                                AT 526
      CALL PHIX ( PHIP, PHIPX, XMACH )                                  AT 527
      PHIPX = 100.0*( PHIPX - PHIP )/BYBO(JR,IS)                        AT 528
C                                                                       AT 529
      KT = -KSURF(IS,IS)                                                AT 530
C                                                                       AT 531
      CALL CALCM ( +1.0, YB, MBAR2, NR2, BMACH(1,KT), PHIM, D(1),D(12)) AT 532
      CALL CALCM ( +.99, YB, MBAR2, NR2, BMACH(1,KT), PHIMX,D(1),D(12)) AT 533
      GMACHM(JR) = PHIM                                                 AT 534
      CALL PHIX ( PHIM, PHIMX, XMACH )                                  AT 535
      PHIMX = 100.0*( PHIM - PHIMX )/BYBO(JR,KT)                        AT 536
C                                                                       AT 537
      EK(JR) = ( PHIPX + ZMBAR*PHIMX + RK3*( PHIM - 2.0/(GAMMA-1.0)))/  AT 538
     1                                     ( PHIP - PHIM )              AT 539
C                                                                       AT 540
 3030 IF ( IS .EQ. KS ) GO TO 3100                                      AT 541
C                                                                       AT 542
      CONST = 2.0*SOBR*RK3                                              AT 543
      IF ( ISTYPE(KS) .GT. 2 ) CONST = 2*CONST                          AT 544
      IF ( JR .GT. 1 ) GO TO 3050                                       AT 545
C                                                                       AT 546
      JJ = NJ(KS)                                                       AT 547
      CALL TNXI ( TN, XIBAR(1,KS), JJ, MBAR2, ICHORD(KS) )              AT 548
      P3 = 2.0*PI/( 2*JJ+1.0 )                                          AT 549
      DO 3040 J=1,JJ                                                    AT 550
 3040 W1(J) = P3*( 1.0 - XIBAR(J,KS) )                                  AT 551
 3050 DO 3045 JMU=1,MBAR2                                               AT 552
      GETA(JMU) = 0.0                                                   AT 553
      DO 3045 J=1,JJ                                                    AT 554
 3045 GETA(JMU) = GETA(JMU) + W1(J)*TN(JMU,J)*CEXP( CMPLX( 0.0,         AT 555
     1            RK(IK)*( XIBAR(J,KS) - 1.0 )*BYBO(JR,KS) ) )          AT 556
C                                                                       AT 557
      MUNU = 0                                                          AT 558
      DO 3060 JMU=1,MBAR2                                               AT 559
      DO 3060 JNU=1,NR2                                                 AT 560
      MUNU = MUNU + 1                                                   AT 561
C                                                                       AT 562
 3060 ACOEF(MUNU) = GETA(JMU)*UNY(JNU)*CONST                            AT 563
C                                                                       AT 564
      IF ( KSURF(KS,KS) .NE. IS ) GO TO 3080                            AT 565
C                                                                       AT 566
      X3 = 0.999                                                        AT 567
      Q3 = SQRT ( 0.001/1.999 )                                         AT 568
C                                                                       AT 569
      CALL TNXI ( TNX, X3, 1, MBAR2, ICHORD(KS) )                       AT 570
C                                                                       AT 571
      CONST = 2*SOBR*ZMBAR/BYBO(JR,KS)                                  AT 572
      IF ( ISTYPE(KS) .GT. 2 ) CONST = 2.0*CONST                        AT 573
C                                                                       AT 574
      MUNU = 0                                                          AT 575
      DO 3070 JMU=1,MBAR2                                               AT 576
      DO 3070 JNU=1,NR2                                                 AT 577
      MUNU = MUNU + 1                                                   AT 578
C                                                                       AT 579
 3070 ACOEF(MUNU) = ACOEF(MUNU) + TNX(JMU,1)*UNY(JNU)*CONST*Q3          AT 580
 3080 IF ( KSURF(KS,KS) ) 3120, 3400, 3400                              AT 581
C                                                                       AT 582
 3100 X3 = -0.999                                                       AT 583
      Q3 = SQRT ( 1.999/0.001 )                                         AT 584
C                                                                       AT 585
      CALL TNXI ( TNX, X3, 1, MBAR2, ICHORD(KS) )                       AT 586
C                                                                       AT 587
      CONST = 2*SOBR/BYBO(JR,KS)                                        AT 588
      IF ( ISTYPE(KS) .GT. 2 ) CONST = 2.0*CONST                        AT 589
C                                                                       AT 590
      MUNU = 0                                                          AT 591
      DO 3110 JMU=1,MBAR2                                               AT 592
      DO 3110 JNU=1,NR2                                                 AT 593
      MUNU = MUNU + 1                                                   AT 594
C                                                                       AT 595
 3110 ACOEF(MUNU) = TNX(JMU,1)*UNY(JNU)*CONST*Q3                        AT 596
C                                                                       AT 597
 3120 CONST = -2*EK(JR)*AR(KS)                                          AT 598
C                                                                       AT 599
      DO 3130 JNU=1,NR2                                                 AT 600
      MUNU = MUNU + 1                                                   AT 601
C                                                                       AT 602
 3130 ACOEF(MUNU) =  UNY(JNU)*CONST                                     AT 603
C                                                                       AT 604
 3400 IF ( LSPAN(KS) .NE. 1 ) Y2 = -1.0                                 AT 605
C                                                                       AT 606
      DO 3440 I=1,MUNU                                                  AT 607
 3440 ACOEF(I) = Y2*ACOEF(I)                                            AT 608
C                                                                       AT 609
 3450 WRITE (1) ( ACOEF(I), I=1,MUNU )                                  AT 610
C                                                                       AT 611
 3405 IF ( IDUMP .NE. 0 ) WRITE (6,3410) JR, ( ACOEF(I), I=1,MUNU )     AT 612
C                                                                       AT 613
 3410 FORMAT (/,9X,"SHOCK BC.S FOR DOWNWASH ROW ",I2,//,( 3X,5E15.7 ) ) AT 614
C                                                                       AT 615
 3500 CONTINUE                                                          AT 616
C                                                                       AT 617
 4000 CONTINUE                                                          AT 618
C                                                                       AT 619
 5000 CONTINUE                                                          AT 620
      END                                                               AT 621
      SUBROUTINE TUNPSI ( JR, JI, IS, KS, JS, P3, JJ, MBAR2, NS3, IR,   AU   1
     1                    COSP, SINP, COSKS, SINKS, RK2 )               AU   2
C     SUBROUTINE TO CALCULATE THE CHORDWISE INTEGRAL CORRECTION TERM    AU   3
C     AND THE DOWNWASH CHORD INTEGRAL IN TRANSONIC FLOW.                AU   4
C                                                                       AU   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AU   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AU   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AU   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AU   9
C                                                                       AU  10
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AU  11
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AU  12
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AU  13
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AU  14
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AU  15
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AU  16
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AU  17
C                                                                       AU  18
      COMMON /UNFUN/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AU  19
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AU  20
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AU  21
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AU  22
      COMPLEX GETA, GYY, HPSI, RK3, C2                                  AU  23
C                                                                       AU  24
      RK3 = CMPLX( 0.0, RK2 )                                           AU  25
      SOBR = SO(KS)*BRINV                                               AU  26
      IF ( ISTYPE(KS) .GT. 2 ) SOBR = SOBR*0.5                          AU  27
      Z1 =  Z*SOBR                                                      AU  28
C                                                                       AU  29
      IF ( GMACH .GE. 1.0 ) GO TO 30                                    AU  30
C                                                                       AU  31
      IF ( JS .NE. 62 ) GO TO 200                                       AU  32
C                                                                       AU  33
      IF ( Z .NE. 0.0 ) GO TO 50                                        AU  34
C                                                                       AU  35
      DO 20 JMU=1,MBAR2                                                 AU  36
      HPSI(JMU,1) = 0.0                                                 AU  37
      DO 10 J=1,JJ                                                      AU  38
      IF ( XIS2(J) .GT. XS(JI,JR,IS)) GO TO 20                          AU  39
   10 HPSI(JMU,1) = HPSI(JMU,1) + W1(J)*TN(JMU,J)                       AU  40
     1                          *CEXP( RK3*(XIS2(J)-XS(JI,JR,IS)) )     AU  41
   20 CONTINUE                                                          AU  42
      GO TO 1000                                                        AU  43
C                                                                       AU  44
   30 IF ( JS .NE. 62 .AND. Z .EQ. 0.0 ) GO TO 200                      AU  45
C                                                                       AU  46
      CALL TNXI ( TN, XIB2, JJ, MBAR2, +1 )                             AU  47
C                                                                       AU  48
      IF ( Z .NE. 0.0 ) GO TO 50                                        AU  49
C                                                                       AU  50
      DO 40 JMU=1,MBAR2                                                 AU  51
      HPSI(JMU,1) = 0.0                                                 AU  52
      DO 40 J=1,JJ                                                      AU  53
   40 HPSI(JMU,1) = HPSI(JMU,1) + W1(J)*TN(JMU,J)                       AU  54
     1                          *CEXP( RK3*(XIS2(J)-XS(JI,JR,IS)) )     AU  55
      GO TO 1000                                                        AU  56
C                                                                       AU  57
   50 COSP2 = COSP*COSKS + SINP*SINKS                                   AU  58
      SINP2 = SINP*COSKS - COSP*SINKS                                   AU  59
C                                                                       AU  60
      IF ( JS .NE. 62 ) GO TO 100                                       AU  61
C                                                                       AU  62
      CKINF = Z1*Z1*0.5/COSP2                                           AU  63
C                                                                       AU  64
      CALL TKERNU ( HPSI(1,2), GMACH, JJ, 1, RK2, XS(JI,JR,IS),         AU  65
     1     0.0,Z1, COSP2, SINP2, (SIGETA(1,KS)-SIGY(JR,IS)),            AU  66
     2     XIS2, 0.0, 0.0, 1.0, 0.0 )                                   AU  67
C                                                                       AU  68
      DO 60 J=1,JJ                                                      AU  69
   60 HPSI(J,2) = HPSI(J,2)*CKINF*W1(J)                                 AU  70
C                                                                       AU  71
      DO 70 JMU=1,MBAR2                                                 AU  72
      HPSI(JMU,1) = 0.0                                                 AU  73
      DO 70 J=1,JJ                                                      AU  74
   70 HPSI(JMU,1) = HPSI(JMU,1) + TN(JMU,J)*HPSI(J,2)                   AU  75
C                                                                       AU  76
      IF ( GMACH .LT. 1.0 ) GO TO 1000                                  AU  77
      GO TO 120                                                         AU  78
C                                                                       AU  79
  100 DO 110 JMU=1,MBAR2                                                AU  80
  110 HPSI(JMU,1) = 0.0                                                 AU  81
      Y0 = YS(JR,IS) - ETAS2(JS)                                        AU  82
      Z0 = ZY(JR,IS) - ZETAS(JS)                                        AU  83
      R2 = Y0**2 + Z0**2                                                AU  84
      T2 =-(Z0*COSP-Y0*SINP)*(Z0*COSKS-Y0*SINKS)*2.0*BETA2/R2           AU  85
      GO TO 130                                                         AU  86
C                                                                       AU  87
  120 R2 = Z1*Z1                                                        AU  88
      T2 = -BETA2*0.5/COSP2                                             AU  89
C                                                                       AU  90
  130 XLE = YQ(1)                                                       AU  91
      BY = YQ(2)                                                        AU  92
      XISH = (XMC-XLE)*(XIB2(JJ)-XIB2(1))/(XIS2(JJ)-XIS2(1)) - 1.0      AU  93
      XSH = XMC                                                         AU  94
      IF ( XISH .GT. 1.0 ) GO TO 1000                                   AU  95
C                                                                       AU  96
  135 CALL TNXI ( TNX(1,1), XISH, 1 , MBAR2, 1 )                        AU  97
      IND = 0                                                           AU  98
      CALL CHDTSS ( PSH, XISH, XISH, 1, ICHORD(KS), LSPAN(KS), IND, 1,  AU  99
     1              XMACH, BRPT(1,1,KS), YQ(3), JSUROP )                AU 100
C                                                                       AU 101
      C1 = 1.0/( P3*BY*SQRT( (XLE-XS(JI,JR,IS))**2 + BETA2*R2 ) )       AU 102
      IF ( JSUROP .NE. 0 ) C1 = C1*BREF/SO(KS)                          AU 103
C                                                                       AU 104
      DO 140 J=1,JJ                                                     AU 105
      X0 = XS(JI,JR,IS) - XIS2(J)                                       AU 106
  140 C1 = C1 + X0*SQRT( (1-XICT(J)**2)/( ( X0**2 + BETA2*R2 )**3 ) )   AU 107
      C2 = C1*T2*PSH*CEXP( RK3*( XSH - XS(JI,JR,IS) ) )                 AU 108
      DO 150 JMU=1,MBAR2                                                AU 109
  150 HPSI(JMU,1) = HPSI(JMU,1) + C2*TNX(JMU,1)                         AU 110
      GO TO 1000                                                        AU 111
C                                                                       AU 112
  200 DO 210 JMU=1,MBAR2                                                AU 113
  210 HPSI(JMU,1) = 0.0                                                 AU 114
C                                                                       AU 115
 1000 RETURN                                                            AU 116
      END                                                               AU 117
      SUBROUTINE TUNGEO ( JR, JI, JJ, JS, P3, NS3, IS, KS,              AV   1
     1                    COSKS, COSK2, IR )                            AV   2
C                                                                       AV   3
C     SUBROUTINE TO CALCULATE THE CHORDWISE INTEGRATION POINT ARRAY     AV   4
C     AT THE JS STATION AND OTHER GEOMETRIC DATA.                       AV   5
C                                                                       AV   6
C                                                                       AV   7
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AV   8
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AV   9
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AV  10
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AV  11
C                                                                       AV  12
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AV  13
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AV  14
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AV  15
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AV  16
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AV  17
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AV  18
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AV  19
C                                                                       AV  20
      COMMON /UNFUN/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AV  21
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AV  22
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AV  23
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AV  24
C                                                                       AV  25
      COMPLEX GETA, GYY, HPSI                                           AV  26
C                                                                       AV  27
      IF ( JS .EQ. 1 ) IND = 0                                          AV  28
      BRAT = 0.0                                                        AV  29
      IF ( JSUROP .EQ. 0 .AND. GMACH .LT. 1.0 ) GO TO 500               AV  30
      IF ( JS .NE. 62 ) GO TO 10                                        AV  31
      IF ( IS .NE. KS ) GO TO 5                                         AV  32
      Y4  = Y*SO(KS)                                                    AV  33
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AV  34
      BY  = BYBO(JR,IS)                                                 AV  35
      R   = 0                                                           AV  36
      XMC = XS(JI,JR,IS)                                                AV  37
      XLE = XMC - BYBO(JR,IS)*( XBAR(JI,IS) + 1.0 )                     AV  38
      GO TO 100                                                         AV  39
C                                                                       AV  40
    5 Z4  = Z*SO(KS)                                                    AV  41
      IF ( ISTYPE(KS) .GT. 2 ) Z4 = 0.5*Z4                              AV  42
      R   = ABS( Z4*BRINV )*BETA                                        AV  43
      XMC = XS(JI,JR,IS) - R                                            AV  44
      Y4  = Y*SO(KS)                                                    AV  45
      GO TO 15                                                          AV  46
C                                                                       AV  47
   10 R   = SQRT( (YS(JR,IS)-ETAS2(JS))**2 + (ZY(JR,IS)-ZETAS(JS))**2 ) AV  48
     1      *BETA                                                       AV  49
      XMC = XS(JI,JR,IS) - R                                            AV  50
      Y4  = ETAB2(JS)*SO(KS)                                            AV  51
C                                                                       AV  52
      IF ( JS .LE. NS3 .AND. IS .EQ. KS ) GO TO 15                      AV  53
      BY  = BETABO(JS,KS)                                               AV  54
      XLE = XISLTE(1,JS,KS)                                             AV  55
      XTE = XISLTE(2,JS,KS)                                             AV  56
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AV  57
      GO TO 20                                                          AV  58
C                                                                       AV  59
   15 IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AV  60
C                                                                       AV  61
      CALL XMBY ( XM, BY, Y4, BRPT(1,1,KS), NEND(KS) )                  AV  62
C                                                                       AV  63
      XLE = ( XM - BY )*BRINV + XV(KS)                                  AV  64
      XTE = ( XM + BY )*BRINV + XV(KS)                                  AV  65
      BY  = BY*BRINV                                                    AV  66
C                                                                       AV  67
   20 IF ( XMC .GT. XLE ) GO TO 30                                      AV  68
      P3 = 0.0                                                          AV  69
      GO TO 1000                                                        AV  70
C                                                                       AV  71
C     P3 IS SET TO ZERO IF THE MACH CONE IS FORWARD OF THE LEADING EDGE.AV  72
C                                                                       AV  73
   30 IF ( XMC .LT. XTE ) GO TO 100                                     AV  74
      IF ( JJ .NE. NJ(KS) ) GO TO 101                                   AV  75
      IF ( IS .EQ. KS .OR. JS .EQ. 62 ) GO TO 101                       AV  76
C                                                                       AV  77
      DO 40 J=1,JJ                                                      AV  78
      XICT(J) = XIBAR(J,KS)                                             AV  79
      XIB2(J) = XIBAR(J,KS)                                             AV  80
   40 XIS2(J) = XIS(J,JS,KS)                                            AV  81
C                                                                       AV  82
      CALL CHDTSS ( W1, XIB2, XIB2, JJ, ICHORD(KS), LSPAN(KS), IND, 0,  AV  83
     1              XMACH, BRPT(1,1,KS), Y4, JSUROP )                   AV  84
C                                                                       AV  85
   60 P3 = PI/JJ                                                        AV  86
      IF ( IXI(KS) .NE. 2 ) P3 = 2.0*PI/( 2.0*JJ + 1.0 )                AV  87
      GO TO 1000                                                        AV  88
C                                                                       AV  89
  100 XTE = XMC                                                         AV  90
  101 XM2 = 0.5*( XTE + XLE )                                           AV  91
      BY2 = 0.5*( XTE - XLE )                                           AV  92
      BRAT = BY2/BY                                                     AV  93
C                                                                       AV  94
      IF ( IS .EQ. KS .OR. JJ .NE. NJ(KS) ) GO TO 200                   AV  95
C                                                                       AV  96
  105 DO 110 J=1,JJ                                                     AV  97
      XICT(J) = XIBAR(J,KS)                                             AV  98
      XIB2(J) = BRAT*( 1.0 + XIBAR(J,KS) ) - 1.0                        AV  99
  110 XIS2(J) = XM2 + BY2*XIBAR(J,KS)                                   AV 100
C                                                                       AV 101
      CALL CHDTSS ( W1, XIB2, XIBAR(1,KS), JJ, ICHORD(KS), LSPAN(KS),   AV 102
     1              IND, 0, XMACH, BRPT(1,1,KS), Y4, JSUROP )           AV 103
C                                                                       AV 104
      GO TO 60                                                          AV 105
C                                                                       AV 106
  200 P3 = PI/JJ                                                        AV 107
C                                                                       AV 108
      DO 210 J=1,JJ                                                     AV 109
      XIB2(J) = BRAT*( 1.0 + XICT(J) ) - 1.0                            AV 110
  210 XIS2(J) = XM2 + BY2*XICT(J)                                       AV 111
C                                                                       AV 112
      CALL CHDTSS ( W1, XIB2, XICT, JJ, ICHORD(KS), LSPAN(KS), IND, 0,  AV 113
     1              XMACH, BRPT(1,1,KS), Y4, JSUROP )                   AV 114
C                                                                       AV 115
      GO TO 1000                                                        AV 116
C                                                                       AV 117
  500 Y4  = Y*SO(KS)                                                    AV 118
      IF ( JS .NE. 62 ) Y4 = ETAB2(JS)*SO(KS)                           AV 119
      IF ( ISTYPE(KS) .GT. 2 ) Y4 = 0.5*( Y4 + SO(KS) )                 AV 120
C                                                                       AV 121
      CALL XMBY ( XM, BY, Y4, BRPT(1,1,KS), NEND(KS) )                  AV 122
C                                                                       AV 123
      BY  = BY*BRINV                                                    AV 124
      XM  = XM*BRINV + XV(KS)                                           AV 125
C                                                                       AV 126
      DO 510 J=1,JJ                                                     AV 127
  510 XIS2(J) = XM + XICT(J)*BY                                         AV 128
C                                                                       AV 129
 1000 IF ( BRAT .NE. 0.0 ) P3 = P3*BRAT                                 AV 130
      IF ( JSUROP .NE. 0 ) P3 = P3*BREF*BY/SO(KS)                       AV 131
      YQ(1) = XLE                                                       AV 132
      YQ(2) = BY                                                        AV 133
      YQ(3) = Y4                                                        AV 134
      RETURN                                                            AV 135
      END                                                               AV 136
      SUBROUTINE GEOMTU ( JR, IS, KS, NS2, NS3, JS1, JS2, YV2, ZV2,     AW   1
     1                    CKSS, SKSS, LSPA, ISTP )                      AW   2
C                                                                       AW   3
C     SUBROUTINE TO CALCULATE THE TRANSFORMED SPANWISE INTEGRATION      AW   4
C     POINT ARRAY FOR IS .EQ. KS.                                       AW   5
C     IF IS .NE. KS, THE ARRAYS ARE SET UP BUT NO TRANSFORMATION IS     AW   6
C     PERFORMED.                                                        AW   7
C                                                                       AW   8
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  AW   9
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   AW  10
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)AW  11
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), GMACH  AW  12
C                                                                       AW  13
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), AW  14
     1 ALPO(10), ITRANS(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  AW  15
     2 ETABAR(31,10), XIBAR(15,10), XIS(15,31,10), YBAR(15,10),         AW  16
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      AW  17
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  AW  18
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), AW  19
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            AW  20
C                                                                       AW  21
      COMMON /UNFUN/ GETA(61), GYY, HPSI(10,31), TN(10,67), DUNY(30),   AW  22
     1 SY2(61), TNX(10,2), UN(15,31), UNY(30), CK(6), YQ(6),QC(6),IC(6),AW  23
     2 ETAB2(62), ETAS2(62), SIGS(62), ZETAS(62), XIB3(22), XIS3(22),   AW  24
     3 XIB2(67), XIS2(67), W2(22), W1(67), XICT(67), NJ3, S6, Y, Z, XMC AW  25
      COMPLEX GETA, GYY, HPSI                                           AW  26
C                                                                       AW  27
      NR2  = NS(KS)                                                     AW  28
      IF ( IS .NE. KS ) GO TO 45                                        AW  29
C                                                                       AW  30
      DO 10 JS=1,NS3                                                    AW  31
      IF ( Y .LT. ETABAR(JS,KS) ) GO TO 20                              AW  32
   10 CONTINUE                                                          AW  33
C                                                                       AW  34
   20 JS1 = NS3 + 1 - JS                                                AW  35
      JS2 = JS1 + 1                                                     AW  36
C                                                                       AW  37
      DO 25 JS=1,JS1                                                    AW  38
      ETAB2(JS) = Y + ETABAR(JS,KS) + 1.0                               AW  39
      ETAS2(JS) = YV2 + ETAB2(JS)*CKSS                                  AW  40
      ZETAS(JS) = ZV2 + ETAB2(JS)*SKSS                                  AW  41
   25 SIGS(JS)  = SIGETA(JS,KS)                                         AW  42
C                                                                       AW  43
      DO 30 JS=JS2,NS3                                                  AW  44
      ETAB2(JS) = Y + ETABAR(JS,KS) - 1.0                               AW  45
      ETAS2(JS) = YV2 + ETAB2(JS)*CKSS                                  AW  46
      ZETAS(JS) = ZV2 + ETAB2(JS)*SKSS                                  AW  47
   30 SIGS(JS)  = SIGETA(JS,KS)                                         AW  48
C                                                                       AW  49
      IF ( ISTYPE(KS) .NE. 3 ) GO TO 50                                 AW  50
C                                                                       AW  51
      NS3P1 = NS3 + 1                                                   AW  52
   35 DO 40 JS=NS3P1,NS2                                                AW  53
      ETAB2(JS) = ETABAR(JS,KS)                                         AW  54
      ETAS2(JS) = ETAS(JS,KS)                                           AW  55
      ZETAS(JS) = ZETA(JS,KS)                                           AW  56
   40 SIGS(JS)  = SIGETA(JS,KS)                                         AW  57
      IF ( IS - KS ) 100, 50, 100                                       AW  58
C                                                                       AW  59
   45 NS3P1 = 1                                                         AW  60
      GO TO 35                                                          AW  61
C                                                                       AW  62
   50 CALL UNETA ( UN, ETAB2, NS2, NR2, LSYM(KS), ISTP, LSPA )          AW  63
C                                                                       AW  64
      IF ( LSPA .NE. 1 ) GO TO 60                                       AW  65
C                                                                       AW  66
      DO 55 JS=1,NS2                                                    AW  67
C                                                                       AW  68
      SETA = SQRT( 1.0 - ETAB2(JS)**2 )                                 AW  69
      DO 55 JNU=1,NR2                                                   AW  70
   55 UN(JNU,JS) = UN(JNU,JS)*SETA                                      AW  71
C                                                                       AW  72
C                                                                       AW  73
   60 CALL WEIGHT ( SY2(1), ETABAR(1,KS), NS3, A, A(71) )               AW  74
C                                                                       AW  75
      IF ( NS3 .NE. NS2 )                                               AW  76
     1CALL WEIGHT ( SY2(NS3+1), ETABAR(NS3+1,KS), NS3, A, A(71) )       AW  77
C                                                                       AW  78
      DO 65 JS=1,NS2                                                    AW  79
      DO 65 JNU=1,NR2                                                   AW  80
   65 UN(JNU,JS) = UN(JNU,JS)*SY2(JS)                                   AW  81
C                                                                       AW  82
  100 RETURN                                                            AW  83
      END                                                               AW  84
      SUBROUTINE TKERNU ( CK, XMACH, JJ, NS2, FK, X, Y, Z, COSP, SINP,  AX   1
     1                    SIG, XI, ETA, ZETA, COSQ, SINQ )              AX   2
C                                                                       AX   3
C     SUBROUTINE TO COMPUTE THE PLANAR OR NONPLANAR SUBSONIC OR         AX   4
C     SUPERSONIC KERNEL FUNCTION FOR UNSTEADY TRANSONIC FLOW.           AX   5
C                                                                       AX   6
      DIMENSION CK(JJ), XI(JJ)                                          AX   7
      COMPLEX   CK, CFK, CK1, CK2, CK3, CK4, FK1, EK1, EK2              AX   8
C                                                                       AX   9
      BETA2= 1.0 - XMACH*XMACH                                          AX  10
      CFK  = CMPLX( 0.0, -FK )                                          AX  11
      IF ( ABS(Z-ZETA) .GT. ABS(Y-ETA)*0.01 ) GO TO 100                 AX  12
      IF ( ABS(SINP-SINQ) .GT. ABS(COSP+COSQ)*0.005 ) GO TO 100         AX  13
C                                                                       AX  14
      Y0 = Y - ETA                                                      AX  15
      R2 = Y0*Y0                                                        AX  16
      R  = ABS( Y0 )                                                    AX  17
      FK1 = CFK*R                                                       AX  18
      IF ( XMACH .LT. 1.0 ) GO TO 20                                    AX  19
C                                                                       AX  20
      DO 10 J=1,JJ                                                      AX  21
      X0  = X - XI(J)                                                   AX  22
      RR2 = 1.0/( X0*X0 + BETA2*R2 )                                    AX  23
      RR  = SQRT( RR2 )                                                 AX  24
      U1  = ( XMACH/RR - X0 )/( BETA2*R )                               AX  25
      U2  = (-XMACH/RR - X0 )/( BETA2*R )                               AX  26
C                                                                       AX  27
      X1  = X0*RR                                                       AX  28
      EK1 = CEXP( FK1*U1 )                                              AX  29
      EK2 = CEXP( FK1*U2 )                                              AX  30
C                                                                       AX  31
      CALL SPRI1 ( U1, U2, -FK1, CK1, CK2, EK1, EK2 )                   AX  32
C                                                                       AX  33
      CK1 = -CK1 + (X1+1.0)*EK1 + CK2 + (X1-1.0)*EK2                    AX  34
C                                                                       AX  35
   10 CK(J)   = -CK1*CEXP( CFK*X0 )/R2                                  AX  36
      GO TO 1000                                                        AX  37
C                                                                       AX  38
   20 DO 30 J=1,JJ                                                      AX  39
      X0  = X - XI(J)                                                   AX  40
      RR2 = 1.0/( X0*X0 + BETA2*R2 )                                    AX  41
      RR  = SQRT( RR2 )                                                 AX  42
      U1  = ( XMACH/RR - X0 )/( BETA2*R )                               AX  43
C                                                                       AX  44
      X1  = 1.0 + X0*RR                                                 AX  45
      EK1 = CEXP( FK1*U1 )                                              AX  46
C                                                                       AX  47
      CALL SUBI1 ( U1, FK*R, CK1 )                                      AX  48
C                                                                       AX  49
   30 CK(J)   = -( X1*EK1 - CK1 )*CEXP( CFK*X0 )/R2                     AX  50
      GO TO 1000                                                        AX  51
C                                                                       AX  52
  100 T1 = COSP*COSQ + SINP*SINQ                                        AX  53
C                                                                       AX  54
      Y0 = Y - ETA                                                      AX  55
      Z0 = Z - ZETA                                                     AX  56
      T2 = ( Z0*COSP - Y0*SINP )*( Z0*COSQ - Y0*SINQ )                  AX  57
      R2 = Y0*Y0 + Z0*Z0                                                AX  58
      OR2 = 1.0/R2                                                      AX  59
      R   = SQRT( R2 )                                                  AX  60
      FK1 = CFK*R                                                       AX  61
C                                                                       AX  62
      IF ( XMACH .LT. 1.0 ) GO TO 150                                   AX  63
C                                                                       AX  64
      DO 110 J=1,JJ                                                     AX  65
      X0  = X - XI(J)                                                   AX  66
      RR2 = 1.0/( X0*X0 + BETA2*R2 )                                    AX  67
      RR  = SQRT( RR2 )                                                 AX  68
      U1  = ( XMACH/RR - X0 )/( BETA2*R )                               AX  69
      U2  = (-XMACH/RR - X0 )/( BETA2*R )                               AX  70
C                                                                       AX  71
      X1  = X0*RR                                                       AX  72
      EK1 = CEXP( FK1*U1 )                                              AX  73
      EK2 = CEXP( FK1*U2 )                                              AX  74
C                                                                       AX  75
      CALL SPRI2 ( U1, U2, -FK1, CK1, CK2, CK3, CK4, EK1, EK2 )         AX  76
C                                                                       AX  77
      CK3 = CK3 - ( 2*(X1+1.0) + R2*RR2*( BETA2*X1 + FK1*(1.0-BETA2)/   AX  78
     1                           SQRT( 1.0 + U1*U1 ) ) )*EK1            AX  79
     2    - CK4 - ( 2*(X1-1.0) + R2*RR2*( BETA2*X1 - FK1*(1.0-BETA2)/   AX  80
     3                           SQRT( 1.0 + U2*U2 ) ) )*EK2            AX  81
C                                                                       AX  82
      CK3 = CK3*OR2                                                     AX  83
C                                                                       AX  84
      CK1 = -CK1 + (X1+1.0)*EK1 + CK2 + (X1-1.0)*EK2                    AX  85
C                                                                       AX  86
  110 CK(J) = -OR2*( CK1*T1 + CK3*T2 )*CEXP( CFK*X0 )                   AX  87
      GO TO 1000                                                        AX  88
C                                                                       AX  89
  150 DO 160 J=1,JJ                                                     AX  90
                                                                        AX  91
      X0  = X - XI(J)                                                   AX  92
      RR2 = 1.0/( X0*X0 + BETA2*R2 )                                    AX  93
      RR  = SQRT( RR2 )                                                 AX  94
      U1  = ( XMACH/RR - X0 )/( BETA2*R )                               AX  95
C                                                                       AX  96
      X1  = 1.0 + X0*RR                                                 AX  97
      EK1 = CEXP( FK1*U1 )                                              AX  98
C                                                                       AX  99
      CALL SUBI2 ( U1, FK*R, CK1, CK2 )                                 AX 100
C                                                                       AX 101
      CK2 = CK2*OR2 - ( 2*X1*OR2 + RR2*( BETA2*X0*RR                    AX 102
     1                - FK1*U1*XMACH*XMACH/SQRT( 1.0 + U1*U1 ) ) )*EK1  AX 103
C                                                                       AX 104
      CK1 = X1*EK1 - CK1                                                AX 105
C                                                                       AX 106
  160 CK(J) = -OR2*( T1*CK1 + T2*CK2 )*CEXP( CFK*X0 )                   AX 107
C                                                                       AX 108
 1000 RETURN                                                            AX 109
      END                                                               AX 110
      SUBROUTINE SUBI1 ( U1, RK1, CK1 )                                 AY   1
C                                                                       AY   2
C     SUBROUTINE TO COMPUTE THE I1' INTEGRAL BY THE USE OF              AY   3
C     LASCHKA'S EXPONENTIAL APPROXIMATION.                              AY   4
C                                                                       AY   5
      COMPLEX  CK1, C2, C3                                              AY   6
      COMMON / COEF / AN(11), BN(11)                                    AY   7
C                                                                       AY   8
      C1  = -0.372*U1                                                   AY   9
      C2  = CMPLX( 0.0, RK1 )                                           AY  10
      C3  = CEXP ( CMPLX( 0.0,-RK1*U1 ) )                               AY  11
      C4 = 0.0                                                          AY  12
      A1 = ABS(C1)                                                      AY  13
      IF ( A1 .LT. 50.0 ) C4 = EXP( -A1 )                               AY  14
C                                                                       AY  15
      IF ( U1 .LT. 0.0 ) GO TO 20                                       AY  16
      CK1 = 0.0                                                         AY  17
      C5  = 1.0                                                         AY  18
      DO 10 I=1,11                                                      AY  19
      C5  = C5*C4                                                       AY  20
   10 CK1 = CK1 + AN(I)*C5*( C2/CMPLX( I*0.372, RK1 ) - 1.0 )           AY  21
C                                                                       AY  22
      CK1 = ( CK1 + 1.0 - U1/SQRT( 1.0 + U1*U1 ) )*C3                   AY  23
      GO TO 40                                                          AY  24
C                                                                       AY  25
   20 CK1 = -2.0 + ( 1.0 - U1/SQRT( 1.0 + U1*U1 ) )*C3                  AY  26
      RK1S = RK1*RK1                                                    AY  27
      C3  = C3                                                          AY  28
      DO 30 I=1,11                                                      AY  29
      C3  = C3*C4                                                       AY  30
   30 CK1 = CK1 + AN(I)*( C3*(  C2/CMPLX(I*0.372,-RK1) + 1.0  )         AY  31
     1                  + 2.0*RK1S/( (I*0.372)**2 + RK1S ) )            AY  32
C                                                                       AY  33
   40 RETURN                                                            AY  34
      END                                                               AY  35
      SUBROUTINE SUBI2  ( U1, RK1, CK1, CK2 )                           AZ   1
C                                                                       AZ   2
C     SUBROUTINE TO COMPUTE BOTH THE I1' AND I22' INTEGRALS USING       AZ   3
C     EXPONENTIAL APPROXIMATIONS.                                       AZ   4
C                                                                       AZ   5
      COMPLEX CK1, CK2, C2, C3                                          AZ   6
      COMMON / COEF / AN(11), BN(11)                                    AZ   7
C                                                                       AZ   8
      C1  = -0.372*U1                                                   AZ   9
      C2  = CMPLX( 0.0, RK1 )                                           AZ  10
      C3  = CEXP ( CMPLX( 0.0,-RK1*U1 ) )                               AZ  11
      C4 = 0.0                                                          AZ  12
      A1 = ABS(C1)                                                      AZ  13
      IF ( A1 .LT. 50.0 ) C4 = EXP( -A1 )                               AZ  14
      C6  = C4*C4                                                       AZ  15
C                                                                       AZ  16
      IF ( U1 .LT. 0.0 ) GO TO 20                                       AZ  17
      CK1 = 0.0                                                         AZ  18
      CK2 = 0.0                                                         AZ  19
      C5  = 1.0                                                         AZ  20
      C7  = 1.0                                                         AZ  21
      DO 10 I=1,11                                                      AZ  22
      C5  = C5*C4                                                       AZ  23
      C7  = C7*C6                                                       AZ  24
      CK1 = CK1 + ( AN(I)*C5 )/CMPLX( I*0.372, RK1 )                    AZ  25
   10 CK2 = CK2 + ( BN(I)*C7 )/CMPLX( I*0.744, RK1 )                    AZ  26
C                                                                       AZ  27
      CK1 = CK1*C3*C2                                                   AZ  28
      CK2 = CK2*C3*C2                                                   AZ  29
      GO TO 40                                                          AZ  30
C                                                                       AZ  31
   20 CK1 = 2.0*( C3 - 1.0 )                                            AZ  32
      CK2 = CK1                                                         AZ  33
      RK1S = RK1*RK1                                                    AZ  34
      C2  = C3*C2                                                       AZ  35
      C3  = C2                                                          AZ  36
      DO 30 I=1,11                                                      AZ  37
      C2  = C2*C4                                                       AZ  38
      C3  = C3*C6                                                       AZ  39
      CK1 = CK1 + AN(I)*( C2/CMPLX( I*0.372,-RK1 )                      AZ  40
     1                  + 2.0*RK1S/( (I*0.372)**2 + RK1S ) )            AZ  41
   30 CK2 = CK2 + BN(I)*( C3/CMPLX( I*0.744,-RK1 )                      AZ  42
     1                  + 2.0*RK1S/( (I*0.744)**2 + RK1S ) )            AZ  43
C                                                                       AZ  44
   40 CK2 = 3*CK1 - CK2                                                 AZ  45
      RETURN                                                            AZ  46
      END                                                               AZ  47
      SUBROUTINE SPRI1 ( U1, U2, FK1, CK1, CK2, EK1, EK2 )              BA   1
C                                                                       BA   2
C     SUBROUTINE TO COMPUTE THE I1' INTEGRAL FOR SUPERSONIC             BA   3
C     FLOW USING LASCHKA'S APPROXIMATION.                               BA   4
C                                                                       BA   5
      COMPLEX FK1, CK1, CK2, EK1, EK2, C7                               BA   6
C                                                                       BA   7
      COMMON /COEF/ AN(11), BN(11)                                      BA   8
C                                                                       BA   9
      C11 = -0.372*ABS( U1 )                                            BA  10
      C12 = -0.372*ABS( U2 )                                            BA  11
      C2  = AIMAG( FK1 )                                                BA  12
      C41 = 0.0                                                         BA  13
      IF ( C11 .GT. -50.0 ) C41 = EXP( C11 )                            BA  14
      C42 = 0.0                                                         BA  15
      IF ( C12 .GT. -50.0 ) C42 = EXP( C12 )                            BA  16
C                                                                       BA  17
      IF ( U1 .LT. 0.0 ) GO TO 20                                       BA  18
C                                                                       BA  19
      CK1 = 0.0                                                         BA  20
      CK2 = 0.0                                                         BA  21
      C5  = 1.0                                                         BA  22
      C6  = 1.0                                                         BA  23
      DO 10 I=1,11                                                      BA  24
      C5  = C5*C41                                                      BA  25
      C6  = C6*C42                                                      BA  26
      C7  = AN(I)/CMPLX( I*0.372, C2 )                                  BA  27
C                                                                       BA  28
      CK1 = CK1 + C5*C7                                                 BA  29
   10 CK2 = CK2 + C6*C7                                                 BA  30
C                                                                       BA  31
      CK1 = CK1*EK1*FK1                                                 BA  32
      CK2 = CK2*EK2*FK1                                                 BA  33
      GO TO 40                                                          BA  34
C                                                                       BA  35
   20 CK1 = 0.0                                                         BA  36
      CK2 = 0.0                                                         BA  37
      C3  = C2*C2                                                       BA  38
      C5  = 2.0*C3                                                      BA  39
      C6  = 1.0                                                         BA  40
      C7  = EK1*FK1                                                     BA  41
      DO 30 I=1,11                                                      BA  42
      C7  = C7*C41                                                      BA  43
      C6  = C6*C42                                                      BA  44
C                                                                       BA  45
      CK1 = CK1 + AN(I)*( C7/CMPLX( I*0.372,-C2 )                       BA  46
     1                  + C5/( (I*0.372)**2 + C3 ) )                    BA  47
C                                                                       BA  48
   30 CK2 = CK2 + AN(I)*( C6/CMPLX( I*0.372, C2 ) )                     BA  49
C                                                                       BA  50
C                                                                       BA  51
      CK1 = CK1 + 2.0*( EK1 - 1.0 )                                     BA  52
      CK2 = CK2*EK2*FK1                                                 BA  53
C                                                                       BA  54
   40 RETURN                                                            BA  55
      END                                                               BA  56
      SUBROUTINE SPRI2 ( U1, U2, FK1, CK1, CK2, CK3, CK4, EK1, EK2 )    BB   1
C                                                                       BB   2
C     SUBROUTINE TO COMPUTE THE I1' AND I2' INTEGRALS FOR SUPERSONIC    BB   3
C     FLOW USING LASCHKA'S AND CUNNINGHAM'S APPROXIMATIONS RESP.        BB   4
C                                                                       BB   5
      COMPLEX FK1, CK1, CK2, CK3, CK4, EK1, EK2, C7, C8                 BB   6
C                                                                       BB   7
      COMMON /COEF/ AN(11), BN(11)                                      BB   8
C                                                                       BB   9
      C11 = -0.372*ABS( U1 )                                            BB  10
      C12 = -0.372*ABS( U2 )                                            BB  11
      C2  = AIMAG( FK1 )                                                BB  12
      C41 = 0.0                                                         BB  13
      IF ( C11 .GT. -50.0 ) C41 = EXP( C11 )                            BB  14
      C42 = 0.0                                                         BB  15
      IF ( C12 .GT. -50.0 ) C42 = EXP( C12 )                            BB  16
C                                                                       BB  17
      IF ( U1 .LT. 0.0 ) GO TO 20                                       BB  18
C                                                                       BB  19
      CK1 = 0.0                                                         BB  20
      CK2 = 0.0                                                         BB  21
      CK3 = 0.0                                                         BB  22
      CK4 = 0.0                                                         BB  23
      C5  = 1.0                                                         BB  24
      C6  = 1.0                                                         BB  25
      DO 10 I=1,11                                                      BB  26
      C5  = C5*C41                                                      BB  27
      C6  = C6*C42                                                      BB  28
      C7  = AN(I)/CMPLX( I*0.372, C2 )                                  BB  29
      C8  = BN(I)/CMPLX( I*0.744, C2 )                                  BB  30
C                                                                       BB  31
      CK1 = CK1 + C5*C7                                                 BB  32
      CK2 = CK2 + C6*C7                                                 BB  33
C                                                                       BB  34
      CK3 = CK3 + C5*C5*C8                                              BB  35
   10 CK4 = CK4 + C6*C6*C8                                              BB  36
C                                                                       BB  37
      CK1 = CK1*EK1*FK1                                                 BB  38
      CK2 = CK2*EK2*FK1                                                 BB  39
      CK3 = CK3*EK1*FK1                                                 BB  40
      CK4 = CK4*EK2*FK1                                                 BB  41
      GO TO 40                                                          BB  42
C                                                                       BB  43
   20 CK1 = 0.0                                                         BB  44
      CK2 = 0.0                                                         BB  45
      CK3 = 0.0                                                         BB  46
      CK4 = 0.0                                                         BB  47
      C3  = C2*C2                                                       BB  48
      C5  = 2.0*C3                                                      BB  49
      C6  = 1.0                                                         BB  50
      C7  = EK1*FK1                                                     BB  51
      C8  = C7                                                          BB  52
      DO 30 I=1,11                                                      BB  53
      C6  = C6*C42                                                      BB  54
      C7  = C7*C41                                                      BB  55
      C8  = C8*C41*C41                                                  BB  56
C                                                                       BB  57
      CK1 = CK1 + AN(I)*( C7/CMPLX( I*0.372,-C2 )                       BB  58
     1                  + C5/( (I*0.372)**2 + C3 ) )                    BB  59
C                                                                       BB  60
      CK2 = CK2 + AN(I)*( C6/CMPLX( I*0.372,  C2 ) )                    BB  61
C                                                                       BB  62
      CK3 = CK3 + BN(I)*( C8/CMPLX( I*0.744,-C2 )                       BB  63
     1                  + C5/( (I*0.744)**2 + C3 ) )                    BB  64
C                                                                       BB  65
   30 CK4 = CK4 + BN(I)*( C6*C6/CMPLX( I*0.744, C2 ) )                  BB  66
C                                                                       BB  67
      CK1 = CK1 + 2.0*( EK1 - 1.0 )                                     BB  68
      CK2 = CK2*EK2*FK1                                                 BB  69
      CK3 = CK3 + 2.0*( EK1 - 1.0 )                                     BB  70
      CK4 = CK4*EK2*FK1                                                 BB  71
C                                                                       BB  72
   40 CK3 = 3*CK1 - CK3                                                 BB  73
      CK4 = 3*CK2 - CK4                                                 BB  74
      RETURN                                                            BB  75
      END                                                               BB  76
      BLOCK DATA                                                        BC   1
C                                                                       BC   2
      COMMON / COEF / AN(11), BN(11)                                    BC   3
C                                                                       BC   4
      DATA AN / +.2418620 , -2.791803 , +24.99108 , -111.5920 ,         BC   5
     1          +271.4355 , -305.7529 , -41.18363 , +545.9854 ,         BC   6
     2          -644.7816 , +328.7276 , -64.27951 /                     BC   7
C                                                                       BC   8
      DATA BN / +3.509407, -57.17120,+624.7548,-3830.151,+14538.51,     BC   9
     1          -35718.32, +57824.14,-61303.92,+40969.58,-15660.04,     BC  10
     2          +2610.093  /                                            BC  11
C                                                                       BC  12
      END                                                               BC  13
      OVERLAY(R2T,4,0)                                                  BD   1
      PROGRAM    AEROPR                                                 BD   2
      COMMON /MANE/ DUM1(8), FREQ, DUM2(50), RK(50), NK, DUM3(1128)     BD   3
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND    BD   4
      EQUIVALENCE ( NAME, STYCOF, UNSYCO, QGENF )                       BD   5
      DATA NAME /6LCOMPAE/                                              BD   6
C                                                                       BD   7
      REWIND 1                                                          BD   8
      IF ( RK(1) .GT. FREQ ) GO TO 10                                   BD   9
      CALL OVERLAY ( STYCOF, 4, 1 )                                     BD  10
      IF ( NK .EQ. 1 ) GO TO 30                                         BD  11
   10 IF ( IOP2 .GE. 0 ) GO TO 20                                       BD  12
      CALL OVERLAY ( UNSYCO, 4, 2 )                                     BD  13
      GO TO 30                                                          BD  14
   20 CALL OVERLAY ( QGENF,  4, 3 )                                     BD  15
   30 REWIND 1                                                          BD  16
      END                                                               BD  17
      SUBROUTINE MATINV ( A, N, NROWS )                                 BE   1
      DIMENSION A(NROWS,NROWS)                                          BE   2
      COMPLEX PIVOT, A                                                  BE   3
      N1=N+1                                                            BE   4
      DO 1 I=1,N                                                        BE   5
      DO 1 J=1,N                                                        BE   6
      J1=N+2-J                                                          BE   7
      J2=J1-1                                                           BE   8
 1    A(I,J1)=A(I,J2)                                                   BE   9
      J=1                                                               BE  10
      I=0                                                               BE  11
 2    I=I+1                                                             BE  12
      J1=J+1                                                            BE  13
      ID=0                                                              BE  14
      NN=0                                                              BE  15
 3    IF(REAL(A(I,J1)))5,4,5                                            BE  16
 4    JJ=J1+101                                                         BE  17
      IF(AIMAG(A(I,J1)))5,6,5                                           BE  18
 5    IF (ID) 6,10,6                                                    BE  19
 6    IF (I-N) 8,7,8                                                    BE  20
 7    I=0                                                               BE  21
 8    I=I+1                                                             BE  22
      NN=NN+1                                                           BE  23
      IF (N-NN) 20,20,3                                                 BE  24
 10   ID=J                                                              BE  25
      DO 101 L=1,N                                                      BE  26
 101  A(L,J)=CMPLX(0.0,0.0)                                             BE  27
      A(I,J)=CMPLX(1.0,0.0)                                             BE  28
      PIVOT=A(I,J1)                                                     BE  29
      DO 11 M=1,N1                                                      BE  30
 11   A(I,M)=A(I,M)/PIVOT                                               BE  31
      DO 17 L=1,N                                                       BE  32
      IF (I-L) 12,12,15                                                 BE  33
 12   KK=L+1                                                            BE  34
      IF (N-KK) 18,13,13                                                BE  35
 13   PIVOT=A(KK,J1)                                                    BE  36
      DO 14 M=1,N1                                                      BE  37
 14   A(KK,M)=A(KK,M)-PIVOT*A(I,M)                                      BE  38
      GO TO 17                                                          BE  39
 15   PIVOT=A(L,J1)                                                     BE  40
      DO 16 M=1,N1                                                      BE  41
 16   A(L,M)=A(L,M)-PIVOT*A(I,M)                                        BE  42
 17   CONTINUE                                                          BE  43
 18   IF (N-J) 20,20,19                                                 BE  44
 19   J=J1                                                              BE  45
      GO TO 2                                                           BE  46
   20 RETURN                                                            BE  47
      END                                                               BE  48
      SUBROUTINE AECOEF ( AC, D, NW2, NS, NSURF, KSURF, NMODES, RK,     BF   1
     1 BREF )                                                           BF   2
C                                                                       BF   3
C     SUBROUTINE TO CONVERT THE DOWNWASH VECTORS STORED IN ARRAY 'AC'   BF   4
C     TO PRESSURE SERIES COEFICIENT VECTORS IN THE SAME ARRAY.          BF   5
C       THE INCOMING AERO MATRICES ON NUNIT MAY BE EITHER INVERTED      BF   6
C     OR UNINVERTED ACCORDING TO THE OPTIONS IOP1 AND IOPLU.            BF   7
C                                                                       BF   8
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND    BF   9
C                                                                       BF  10
      COMMON /MATRIK/ C(70,70), ALPRS(2,70,20)                          BF  11
C                                                                       BF  12
      DIMENSION AC(70,20), D(100), NW2(10), NS(10), KSURF(10,10)        BF  13
C                                                                       BF  14
      COMPLEX C, AC, D                                                  BF  15
C                                                                       BF  16
      IND = 0                                                           BF  17
C                                                                       BF  18
      IF ( IOP1 .GT. 0 ) GO TO 50                                       BF  19
      IF ( IOPLU .NE. 0 ) WRITE (NUNIT) RK, D                           BF  20
      I2 = 0                                                            BF  21
      DO 20 IS=1,NSURF                                                  BF  22
      I1 = I2 + 1                                                       BF  23
      I2 = I2 + NW2(IS)                                                 BF  24
      IF ( KSURF(IS,IS) .LT. 0 ) I2 = I2 + NS(IS)                       BF  25
C                                                                       BF  26
      M2 = 0                                                            BF  27
      DO 10 KS=1,NSURF                                                  BF  28
      M1 = M2 + 1                                                       BF  29
      M2 = M2 + NW2(KS)                                                 BF  30
      IF ( KSURF(KS,KS) .LT. 0 ) M2 = M2 + NS(KS)                       BF  31
      DO 10 IT=I1,I2                                                    BF  32
   10 READ  (1) ( C(I,IT), I=M1,M2 )                                    BF  33
C                                                                       BF  34
      IF ( IOPLU .EQ. 0 ) GO TO 20                                      BF  35
C                                                                       BF  36
      DO 15 IT=I1,I2                                                    BF  37
   15 WRITE (NUNIT) ( C(I,IT), I=1,M2 )                                 BF  38
C                                                                       BF  39
   20 CONTINUE                                                          BF  40
      GO TO 100                                                         BF  41
C                                                                       BF  42
   50 M2 = 0                                                            BF  43
      DO 60 IS=1,NSURF                                                  BF  44
      M2 = M2 + NW2(IS)                                                 BF  45
      IF ( KSURF(IS,IS) .LT. 0 ) M2 = M2 + NS(IS)                       BF  46
   60 CONTINUE                                                          BF  47
C                                                                       BF  48
   70 READ (NUNIT) RK3, D                                               BF  49
   71 IF ( EOF(NUNIT) .NE. 0 ) GO TO 999                                BF  50
   72 CONTINUE                                                          BF  51
      IF ( ABS( (RK3-RK)/RK ) .LT. 0.001 ) GO TO 80                     BF  52
      DO 75 IT=1,M2                                                     BF  53
   75 READ (NUNIT)                                                      BF  54
      GO TO 70                                                          BF  55
C                                                                       BF  56
   80 DO 90 IT=1,M2                                                     BF  57
   90 READ (NUNIT) ( C(I,IT), I=1,M2 )                                  BF  58
C                                                                       BF  59
      IF ( IOPLU .EQ. 0 ) GO TO 150                                     BF  60
C                                                                       BF  61
  100 CALL MATINV ( C, M2, 70 )                                         BF  62
C                                                                       BF  63
      IF ( IOP1 .GE. 0 ) GO TO 150                                      BF  64
      IF ( IOPLU .NE. 0 ) GO TO 150                                     BF  65
C                                                                       BF  66
      WRITE (NUNIT) RK, D                                               BF  67
      DO 110 IT=1,M2                                                    BF  68
  110 WRITE (NUNIT) ( C(I,IT), I=1,M2 )                                 BF  69
C                                                                       BF  70
  150 DO 180 JA=1,NMODES                                                BF  71
      DO 160 IT=1,M2                                                    BF  72
      D(IT) = ( 0.0, 0.0 )                                              BF  73
      DO 160 I=1,M2                                                     BF  74
  160 D(IT) = D(IT) + C(I,IT)*CMPLX( ALPRS(1,I,JA), RK*ALPRS(2,I,JA)/   BF  75
     1        BREF )                                                    BF  76
      DO 180 IT=1,M2                                                    BF  77
  180 AC(IT,JA) = D(IT)                                                 BF  78
C                                                                       BF  79
      GO TO 1000                                                        BF  80
C                                                                       BF  81
  999 IND = 1                                                           BF  82
      WRITE (6,900) NUNIT, RK                                           BF  83
  900 FORMAT (///,"  AN UNEXPECTED END OF FILE WAS ENCOUNTERED ON ",    BF  84
     1         //,"  THE AERODYNAMIC MATRIX TAPE ON UNIT ",I2,          BF  85
     2         //,"  WHILE SEARCHING FOR THE MATRIX FOR RK = ",E12.4 )  BF  86
C                                                                       BF  87
 1000 RETURN                                                            BF  88
      END                                                               BF  89
      OVERLAY(COMPAE,4,1)                                               BG   1
      PROGRAM STYCOF                                                    BG   2
C                                                                       BG   3
C     SUBROUTINE TO COMPUTE THE STEADY AERODYNAMIC CHARACTERISTICS.     BG   4
C                                                                       BG   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  BG   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   BG   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)BG   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH  BG   9
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), BG  10
     1 ALPO(10), NBREAK(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  BG  11
     2 ETABAR(31,10),XIBAR(15,10), XIS(15,31,10), YBAR(15,10),          BG  12
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      BG  13
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  BG  14
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), BG  15
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            BG  16
C                                                                       BG  17
      COMMON /MATRIK/ C(100,100), ALPRS(100,20), CP(50), XP(50), G(50), BG  18
     1                E(50), D(100), F(300)                             BG  19
C                                                                       BG  20
      COMMON /ALPVCT/ COEF(20,200), XF(200), YF(200), NFS(10), NFS1(10),BG  21
     1   GMASS(20,20), NSTRS, NMODES, DH, DW1, DW2, SPAN2(10),          BG  22
     2   TAN12(10), TAN22(10), CAVG2(10), XR(10), YR(10)                BG  23
C                                                                       BG  24
      COMMON /COMM/ DUM(12)                                             BG  25
      DIMENSION AC(100,20)                                              BG  26
C                                                                       BG  27
      IF ( DUM(12) .NE. 0.0 ) NALP = NMODES                             BG  28
      REWIND 1                                                          BG  29
C                                                                       BG  30
      I2 = 0                                                            BG  31
      DO 50 IS=1,NSURF                                                  BG  32
      I1  = I2 + 1                                                      BG  33
      I2  = I2 + NW2(IS)                                                BG  34
      IF ( DUM(12) .EQ. 0.0 ) GO TO 10                                  BG  35
C                                                                       BG  36
      CALL CALMDS ( XS(1,1,IS), YS(1,IS), BREF, NC(IS), NS(IS),         BG  37
     1              ALPRS(I1,1), A, B, +1, NST(IS), D, +10 )            BG  38
      GO TO 20                                                          BG  39
C                                                                       BG  40
   10 IF ( IDNWSH .NE. 0 ) GO TO 16                                     BG  41
C                                                                       BG  42
      DO 14 K=1,NALP                                                    BG  43
   14 READ (5,5) ( ALPRS(I,K), I=I1,I2 )                                BG  44
    5 FORMAT ( 6F10.0 )                                                 BG  45
      GO TO 20                                                          BG  46
C                                                                       BG  47
   16 DO 18 K=1,NALP                                                    BG  48
      DO 18 I=I1,I2                                                     BG  49
   18 ALPRS(I,K) = 0.0                                                  BG  50
C                                                                       BG  51
   20 DO 22 K=1,NALP                                                    BG  52
      DO 22 I=I1,I2                                                     BG  53
   22 ALPRS(I,K) = ALPRS(I,K) + ALPO(IS)                                BG  54
C                                                                       BG  55
      WRITE (6,24) IS                                                   BG  56
   24 FORMAT (1H1,17X," ALPHA DISTRIBUTIONS FOR SURFACE ", I2, // )     BG  57
C                                                                       BG  58
      DO 26 K=1,NALP                                                    BG  59
   26 WRITE (6,28) K, ( ALPRS(I,K), I=I1,I2 )                           BG  60
   28 FORMAT (/,"    ALPHA VECTOR NO. ",I2, //, ( 5E15.4 ) )            BG  61
C                                                                       BG  62
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 40                               BG  63
C                                                                       BG  64
      I3 = I2 + 1                                                       BG  65
      I2 = I2 + NS(IS)                                                  BG  66
      DO 30 K=1,NALP                                                    BG  67
      DO 30 I=I3,I2                                                     BG  68
   30 ALPRS(I,K) = 0.0                                                  BG  69
C                                                                       BG  70
   40 CONTINUE                                                          BG  71
   50 CONTINUE                                                          BG  72
      M2 = I2                                                           BG  73
C                                                                       BG  74
      CALL AECSTD ( NW2, NS, NSURF, KSURF, NALP, M2, RK(1), IA, IB, AC) BG  75
C                                                                       BG  76
      DO 1500 JA=1,NALP                                                 BG  77
C                                                                       BG  78
      IF ( IDUMP .NE. 0 ) WRITE (6,65) JA, (AC(I,JA), I=1,M2 )          BG  79
   65 FORMAT (1H1,19X,32H THE PRESSURE COEFICIENTS FOR                  BG  80
     1       ,//, 19X 20H       ALPHA VECTOR , I2, // (3X,5E15.7)  )    BG  81
C                                                                       BG  82
   70 FORMAT (1H1,19X,32H THE PRESSURE DISTRIBUTIONS FOR                BG  83
     1       ,//, 19X,20H       ALPHA VECTOR , I2        )              BG  84
      DO 75 I=11,24                                                     BG  85
   75 D(I) = 0.0                                                        BG  86
C                                                                       BG  87
      I2 = 0                                                            BG  88
      DO 1000 IS=1,NSURF                                                BG  89
      WRITE (6,70) JA                                                   BG  90
      IF ( JSUROP .NE. 0 ) GO TO 76                                     BG  91
C                                                                       BG  92
      ICH = ICHORD(IS)                                                  BG  93
      LSP = LSPAN(IS)                                                   BG  94
      IST = ISTYPE(IS)                                                  BG  95
      GO TO 77                                                          BG  96
C                                                                       BG  97
   76 ICH = 1                                                           BG  98
      LSP = 5                                                           BG  99
      IST = 4                                                           BG 100
      IND = 0                                                           BG 101
C                                                                       BG 102
   77 I1 = I2 + 1                                                       BG 103
      I2 = I2 + NW2(IS)                                                 BG 104
      IF ( KSURF(IS,IS) .LT. 0 ) I2 = I2 + NS(IS)                       BG 105
      JR = 0                                                            BG 106
      DO 80 I=I1,I2                                                     BG 107
      JR = JR + 1                                                       BG 108
   80 A(JR) = AC(I,JA)*PI                                               BG 109
C                                                                       BG 110
      WRITE (6,90) IS                                                   BG 111
   90 FORMAT (//, 4X,21H LIFTING SURFACE NO. ,I2,/  )                   BG 112
      XP(1) = -0.95                                                     BG 113
      DO 100 I=2,20                                                     BG 114
  100 XP(I) = -1.0 + 0.1*(I-1)                                          BG 115
      XP(21) = +0.999                                                   BG 116
C                                                                       BG 117
      NC2 = NC(IS)                                                      BG 118
      NS3 = IABS( NS(IS) )                                              BG 119
      DO 170 IY=1,21                                                    BG 120
C                                                                       BG 121
      B2 = SO(IS)                                                       BG 122
      IF ( ISTYPE(IS) .GT. 2 ) GO TO 101                                BG 123
C                                                                       BG 124
      YP = 0.05*(IY-1)                                                  BG 125
      YPSO = SO(IS)*YP                                                  BG 126
      IF ( LSPAN(IS) .EQ. 1 ) B2 = B2*SQRT(1.0 - YP*YP)                 BG 127
      GO TO 102                                                         BG 128
C                                                                       BG 129
  101 YP = 0.1*(IY-1) - 1.0                                             BG 130
      YPSO = SO(IS)*0.05*(IY-1)                                         BG 131
      IF ( LSPAN(IS) .EQ. 1 ) B2 = B2*SQRT(1.0 - YP*YP)                 BG 132
C                                                                       BG 133
  102 CALL UNETA ( G, YP, 1, NS3, LSYM(IS), IST, LSP )                  BG 134
      IF ( ISTYPE(IS) .GT. 2 ) YP = 0.05*(IY-1)                         BG 135
      CALL XMBY ( XTE, BYP, YPSO, BRPT(1,1,IS), NEND(IS) )              BG 136
      IF ( BYP .NE. 0 ) GO TO 110                                       BG 137
C                                                                       BG 138
      WRITE (6,105) YP                                                  BG 139
  105 FORMAT ( //, "  THE CHORD AT YP =",E15.7," IS ZERO",// )          BG 140
      GO TO 170                                                         BG 141
C                                                                       BG 142
  110 B2 = B2/BYP                                                       BG 143
      YPSO = 0.9999*YPSO                                                BG 144
C                                                                       BG 145
      IF ( JSUROP .NE. 0 ) CALL CHDTSS ( B, XP, XP, 21, ICHORD(IS),     BG 146
     1 LSPAN(IS), IND, 1, XMACH, BRPT(1,1,IS), YPSO, JSUROP )           BG 147
C                                                                       BG 148
      DO 150 IX=1,21                                                    BG 149
      MUNU = 0                                                          BG 150
      CALL TNXI ( E, XP(IX), 1, NC(IS), ICH )                           BG 151
      Q1   = SQRT( (1.0 - XP(IX))/(1.0 + XP(IX)) )                      BG 152
C                                                                       BG 153
  130 D(1) = 0.0                                                        BG 154
      DO 140 JI=1,NC2                                                   BG 155
      D(2) = 0.0                                                        BG 156
      DO 135 JR=1,NS3                                                   BG 157
      MUNU = MUNU + 1                                                   BG 158
  135 D(2) = D(2) + G(JR)*A(MUNU)                                       BG 159
  140 D(1) = D(1) + D(2)*E(JI)                                          BG 160
C                                                                       BG 161
      IF ( JSUROP .NE. 0 ) GO TO 145                                    BG 162
C                                                                       BG 163
      CP(IX) = 8.0*B2*D(1)*Q1                                           BG 164
      GO TO 150                                                         BG 165
C                                                                       BG 166
  145 CP(IX) = 8.0*D(1)*B(IX)                                           BG 167
C                                                                       BG 168
  150 CONTINUE                                                          BG 169
C                                                                       BG 170
      WRITE (6,160) YP                                                  BG 171
  160 FORMAT (1H ,/,20X," SPAN STATION, YP=",F8.5,/,                    BG 172
     1            2(31H         XP       CP(XP,YP)    ),/ )             BG 173
      WRITE (6,165) ( XP(IX), CP(IX), IX=1,21 )                         BG 174
  165 FORMAT ( 2(7X,F8.5,E16.7) )                                       BG 175
C                                                                       BG 176
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 170                              BG 177
C                                                                       BG 178
C                                                                       BG 179
      JR = NW2(IS)                                                      BG 180
      D(1) = 0.0                                                        BG 181
      DO 180 J=1,NS3                                                    BG 182
      JR = JR + 1                                                       BG 183
  180 D(1) = D(1) + G(J)*A(JR)                                          BG 184
C                                                                       BG 185
      D(1) = D(1)*8.0*(AR(IS)**2)*BREF/SO(IS)                           BG 186
      IF ( LSPAN(IS) .EQ. 1 ) D(1) = D(1)*SQRT( 1.0 - YP*YP )           BG 187
      WRITE (6,190)  D(1)                                               BG 188
  190 FORMAT (/,"  SHOCK LOAD = ", E16.7, / )                           BG 189
C                                                                       BG 190
  170 CONTINUE                                                          BG 191
C                                                                       BG 192
C                                                                       BG 193
C     CALCULATION OF THE INTEGRATED CHARACTERISTICS.                    BG 194
C                                                                       BG 195
      D(1) = 0.0                                                        BG 196
      D(2) = 0.0                                                        BG 197
      D(3) = 0.0                                                        BG 198
      NS2  = IABS(NSI(IS))                                              BG 199
      NC3  = IABS(NJ (IS))                                              BG 200
      B2   = 2.0*PI/(2.0*NC3+1.0)                                       BG 201
      IND  = 0                                                          BG 202
      KS = ISTYPE(IS)                                                   BG 203
      GO TO ( 300, 300, 320, 330 ), KS                                  BG 204
  300 JS2 = 1 + NS2/2                                                   BG 205
      JS3 = NS2                                                         BG 206
      GO TO 380                                                         BG 207
  320 JS2 = 1                                                           BG 208
      JS3 = NS2/2                                                       BG 209
      GO TO 380                                                         BG 210
  330 JS2 = 1                                                           BG 211
      JS3 = NS2                                                         BG 212
C                                                                       BG 213
  380 KS = 0                                                            BG 214
      DO 500 JS=JS2,JS3                                                 BG 215
      KS = KS + 1                                                       BG 216
      S1 = SQRT(1.0-ETABAR(JS,IS)**2)                                   BG 217
      S2 = XISLTE(1,JS,IS) - ( XV(IS) - BO(IS)*BRINV )                  BG 218
      CALL UNETA ( G, ETABAR(JS,IS), 1, NS3, LSYM(IS), IST, LSP )       BG 219
C                                                                       BG 220
      YPSO = SO(IS)*ETABAR(JS,IS)                                       BG 221
      IF ( ISTYPE(IS) .GT. 1 ) YPSO = 0.5*( YPSO + SO(IS) )             BG 222
      IF ( JSUROP .NE. 0 ) CALL CHDTSS ( F, XIBAR(1,IS), XIBAR(1,IS),   BG 223
     1  NC3, ICHORD(IS), LSPAN(IS), IND, 0, XMACH, BRPT(1,1,IS),        BG 224
     2   YPSO, JSUROP )                                                 BG 225
C                                                                       BG 226
      D(4) = 0.0                                                        BG 227
      D(5) = 0.0                                                        BG 228
C                                                                       BG 229
      DO 450 JJ=1,NC3                                                   BG 230
      CALL TNXI ( E, XIBAR(JJ,IS), 1, NC(IS), ICH )                     BG 231
      Q1 = F(JJ)                                                        BG 232
      IF ( JSUROP .EQ. 0 ) Q1 = 1.0 - XIBAR(JJ,IS)                      BG 233
      MUNU = 0                                                          BG 234
      D(7) = 0.0                                                        BG 235
      DO 400 JI=1,NC2                                                   BG 236
      D(6) = 0.0                                                        BG 237
C                                                                       BG 238
      DO 390 JR=1,NS3                                                   BG 239
      MUNU = MUNU + 1                                                   BG 240
  390 D(6) = D(6) + G(JR)*A(MUNU)                                       BG 241
  400 D(7) = D(7) + D(6)*E(JI)                                          BG 242
      D(7) = D(7)*Q1                                                    BG 243
      D(4) = D(4) + D(7)                                                BG 244
  450 D(5) = D(5) + D(7)*XIBAR(JJ,IS)                                   BG 245
C                                                                       BG 246
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 490                              BG 247
C                                                                       BG 248
      D(100) = 0.0                                                      BG 249
      JR = NW2(IS)                                                      BG 250
      DO 460 J=1,NS3                                                    BG 251
      JR = JR + 1                                                       BG 252
  460 D(100) = D(100) + G(J)*A(JR)                                      BG 253
      D(100) = D(100)*2*AR(IS)*BREF/(B2*SO(IS))                         BG 254
      D(4) = D(4) + D(100)                                              BG 255
      D(5) = D(5) - D(100)                                              BG 256
C                                                                       BG 257
  490 D(8) = D(4)*B2                                                    BG 258
      IF ( LSP .EQ. 1 ) D(8) = D(8)*S1                                  BG 259
      IF ( JSUROP .NE. 0 ) D(8) = D(8)*BETABO(JS,IS)/SO(IS)             BG 260
      B(KS) = D(8)*4.0*AR(IS)                                           BG 261
      XP(KS)= ( D(5)/D(4) + 1.0)*0.5                                    BG 262
      D(8)  = B(KS)*S1                                                  BG 263
      IF ( JS .EQ. JS2 .AND. ISTYPE(IS) .LT. 3 ) D(8) = D(8)*0.5        BG 264
      D(1)  = D(1) + D(8)                                               BG 265
      D(2) = D(2) + D(8)*ETABAR(JS,IS)                                  BG 266
      D(3)  = D(3) + ( XP(KS)*2.0*BETABO(JS,IS) + S2 )*D(8)             BG 267
C                                                                       BG 268
  500 CONTINUE                                                          BG 269
C                                                                       BG 270
  510 CP(1) = D(1)*PI/JS3                                               BG 271
C                                                                       BG 272
      IF ( ISTYPE(IS) .EQ. 3 ) CP(1) = CP(1)*0.5                        BG 273
C                                                                       BG 274
C                                                                       BG 275
  515 CP(2) = D(2)/D(1)                                                 BG 276
      IF ( ISTYPE(IS) .GT. 2 ) CP(2) = 0.5*( CP(2) + 1.0 )              BG 277
      CP(3) = D(3)/D(1)                                                 BG 278
      K0 = KS - 1                                                       BG 279
      IF ( ISTYPE(IS) .NE. 1 ) K0 = 0                                   BG 280
C                                                                       BG 281
C     CP(1) =  LIFT COEFICIENT.                                         BG 282
C     CP(2) =  SPANWISE CENTER OF PRESSURE, FRACTION OF SO(IS).         BG 283
C     CP(3) =  CHORDWISE CENTER OF PRESSURE, FRACTION OF BO(IS) ABOUT   BG 284
C              LEADING EDGE APEX.                                       BG 285
C     B(JS) =  CLC/CAVG                                                 BG 286
C     XP(JS)=  LOCAL XCP IN THE TRANSFORMED COORDINATE SYSTEM.          BG 287
C                                                                       BG 288
      WRITE (6,520) IS                                                  BG 289
  520 FORMAT (1H1,18X," INTEGRATED AERODYNAMIC RESULTS", //             BG 290
     1           ,18X,"       FOR SURFACE NO. ",I2,      //   )         BG 291
      IF (LS .EQ. 1) GO TO 531                                          BG 292
      WRITE (6,530) CP(1), CP(3), CP(2)                                 BG 293
  530 FORMAT(14X,"SYMMETRIC LIFT COEFFICIENT=",E12.6,//,                BG 294
     1    11X, "XCPAVG = ",E12.6, "  YCPAVG = ",E12.6, //,              BG 295
     2       13X,47H  ETA             CLC/CAVG             XCP(ETA),/)  BG 296
      GO TO 533                                                         BG 297
  531 WRITE (6,532) CP(1), CP(3), CP(2)                                 BG 298
  532 FORMAT (14X,"ANTI-SYMMETRIC LIFT COEFFICIENT = ", E12.6, //,      BG 299
     1    11X, "XCPAVG = ",E12.6, "  YCPAVG = ",E12.6, //,              BG 300
     2       13X,47H  ETA             CLC/CAVG             XCP(ETA),/)  BG 301
  533 WRITE (6,540) ( ETABAR(JS+K0,IS), B(JS), XP(JS), JS=1,KS )        BG 302
  540 FORMAT(11X,F8.5, E21.6,E21.6)                                     BG 303
C                                                                       BG 304
      S2 = AREA(IS)                                                     BG 305
      IF ( ISTYPE(IS) .EQ. 4 ) S2 = 0.5*S2                              BG 306
      COSTH = COS( THETA(IS) )                                          BG 307
      SINTH = SIN( THETA(IS) )                                          BG 308
C                                                                       BG 309
      IF ( ABS( COSTH ) .LT. 0.001 ) COSTH = 0.0                        BG 310
      IF ( ABS( SINTH ) .LT. 0.001 ) SINTH = 0.0                        BG 311
C                                                                       BG 312
      D(11) = D(11) + S2*COSTH                                          BG 313
      D(21) = D(21) + S2*SINTH                                          BG 314
      D(1)  = D(1)*S2*PI/JS3                                            BG 315
      IF ( ISTYPE(IS) .GT. 2 ) D(1) = D(1)*0.5                          BG 316
      D(12) = D(12) + D(1)*COSTH                                        BG 317
      D(22) = D(22) + D(1)*SINTH                                        BG 318
      CP(2) = SO(IS)*BRINV*D(1)*CP(2)                                   BG 319
      D(13) = D(13) + CP(2)*COSTH + YV(IS)*D(1)                         BG 320
      D(23) = D(23) + CP(2)*SINTH + ZV(IS)*D(1)                         BG 321
      CP(3) = ( XV(IS) - BO(IS)*BRINV + CP(3) )*D(1)                    BG 322
      D(14) = D(14) + CP(3)*COSTH                                       BG 323
      D(24) = D(24) + CP(3)*SINTH                                       BG 324
C                                                                       BG 325
 1000 CONTINUE                                                          BG 326
C                                                                       BG 327
      CP(1) = D(12)/D(11)                                               BG 328
      CP(2) = D(13)/D(12)                                               BG 329
      CP(3) = D(14)/D(12)                                               BG 330
C                                                                       BG 331
      WRITE (6,1010)  CP(1), CP(3), CP(2)                               BG 332
 1010 FORMAT (1H1,//,14X,"THE INTEGRATED CONFIGURATION CHARACTERISTICS",BG 333
     1            //,14X,"    (A) VERTICAL COMPONENT, ALPHA " ,         BG 334
     1            //,14X,"           CL  = ", E14.7,                    BG 335
     2            //,14X,"           XCP = ", E14.7,                    BG 336
     3            //,14X,"           YCP = ", E14.7  )                  BG 337
C                                                                       BG 338
      IF ( D(21) .EQ. 0.0 .OR. D(22) .EQ. 0.0 ) GO TO 1500              BG 339
      CP(4) = D(22)/D(21)                                               BG 340
      CP(5) = D(23)/D(22)                                               BG 341
      CP(6) = D(24)/D(22)                                               BG 342
C                                                                       BG 343
C                                                                       BG 344
      WRITE (6,1020) CP(4), CP(6), CP(5)                                BG 345
 1020 FORMAT (1H ,//,14X,"    (B) LATERAL COMPONENT, BETA ",            BG 346
     1            //,14X,"           CL  = ",E14.7,                     BG 347
     2            //,14X,"           XCP = ",E14.7,                     BG 348
     3            //,14X,"           ZCP = ",E14.7  )                   BG 349
C                                                                       BG 350
 1500 CONTINUE                                                          BG 351
C                                                                       BG 352
 2000 CONTINUE                                                          BG 353
      END                                                               BG 354
      SUBROUTINE AECSTD ( NW2, NS, NSURF, KSURF, NMODES, M2, RK, IA, IB,BH   1
     1                    AC )                                          BH   2
C                                                                       BH   3
C                                                                       BH   4
C     SUBROUTINE TO CONVERT THE DOWNWASH VECTORS STORED IN ARRAY ALPRS  BH   5
C     TO PRESSURE SERIES COEFICIENT VECTORS IN THE ARRAY AC.            BH   6
C     *** THE INCOMING AERO MATRICES ON NUNIT MAY BE EITHER INVERTED    BH   7
C     OR UNINVERTED ACCORDING TO THE OPTIONS IOP1 AND IOPLU.            BH   8
C                                                                       BH   9
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND    BH  10
C                                                                       BH  11
      COMMON /MATRIK/ C(100,100), ALPRS(100,20), CP(50), XP(50), G(50), BH  12
     1                E(50), D(100), F(300)                             BH  13
C                                                                       BH  14
      DIMENSION NW2(10), NS(10), KSURF(10,10), IA(100), IB(100)         BH  15
      DIMENSION AC(100,20)                                              BH  16
C                                                                       BH  17
      IND = 0                                                           BH  18
C                                                                       BH  19
      IF ( IOP1 .GT. 0 ) GO TO 70                                       BH  20
      IF ( IOPLU .NE. 0 ) WRITE (NUNIT) RK, D                           BH  21
      I2 = 0                                                            BH  22
      DO 20 IS=1,NSURF                                                  BH  23
      I1 = I2 + 1                                                       BH  24
      I2 = I2 + NW2(IS)                                                 BH  25
      IF ( KSURF(IS,IS) .LT. 0 ) I2 = I2 + NS(IS)                       BH  26
C                                                                       BH  27
      M2 = 0                                                            BH  28
      DO 10 KS=1,NSURF                                                  BH  29
      M1 = M2 + 1                                                       BH  30
      M2 = M2 + NW2(KS)                                                 BH  31
      IF ( KSURF(KS,KS) .LT. 0 ) M2 = M2 + NS(KS)                       BH  32
      DO 10 IT=I1,I2                                                    BH  33
   10 READ (1) ( C(I,IT), I=M1,M2 )                                     BH  34
C                                                                       BH  35
      IF ( IOPLU .EQ. 0 ) GO TO 20                                      BH  36
C                                                                       BH  37
      DO 15 IT=I1,I2                                                    BH  38
   15 WRITE (NUNIT) ( C(I,IT), I=1,M2 )                                 BH  39
C                                                                       BH  40
   20 CONTINUE                                                          BH  41
      GO TO 100                                                         BH  42
C                                                                       BH  43
   70 READ (NUNIT) RK3, D                                               BH  44
   71 IF ( EOF(NUNIT) .NE. 0 ) GO TO 999                                BH  45
   72 CONTINUE                                                          BH  46
      IF ( ABS(RK3-RK) .LT. 0.01 ) GO TO 80                             BH  47
C                                                                       BH  48
      WRITE (6,50) NUNIT, RK3, RK                                       BH  49
   50 FORMAT (///,"  THE FIRST MATRIX ON THE INPUT TAPE ON UNIT ",I2,   BH  50
     1         //,"  IS NOT A STEADY FLOW MATRIX. THE K VALUE ON"       BH  51
     2         //,"  THE TAPE IS",E12.4,"  THE VALUE REQUESTED IS",E12.4BH  52
     3  )                                                               BH  53
      IND = 1                                                           BH  54
      GO TO 1000                                                        BH  55
C                                                                       BH  56
   80 DO 90 IT=1,M2                                                     BH  57
   90 READ (NUNIT) ( C(I,IT), I=1,M2 )                                  BH  58
C                                                                       BH  59
      IF ( IOPLU .EQ. 0 ) GO TO 150                                     BH  60
C                                                                       BH  61
  100 CALL INVRT ( C, D, IA, IB, M2, 100, 0 )                           BH  62
C                                                                       BH  63
      IF ( IOP1 .GE. 0 ) GO TO 150                                      BH  64
      IF ( IOPLU .NE. 0 ) GO TO 150                                     BH  65
C                                                                       BH  66
      WRITE (NUNIT) RK, D                                               BH  67
      DO 110 IT=1,M2                                                    BH  68
  110 WRITE (NUNIT) ( C(I,IT), I=1,M2 )                                 BH  69
C                                                                       BH  70
  150 DO 180 JA=1,NMODES                                                BH  71
      DO 160 IT=1,M2                                                    BH  72
      D(IT) = 0.0                                                       BH  73
      DO 160 I=1,M2                                                     BH  74
  160 D(IT) = D(IT) + C(I,IT)*ALPRS(I,JA)                               BH  75
      DO 180 IT=1,M2                                                    BH  76
  180 AC(IT,JA) = D(IT)                                                 BH  77
C                                                                       BH  78
      GO TO 1000                                                        BH  79
C                                                                       BH  80
  999 IND = 1                                                           BH  81
      WRITE (6,900) NUNIT, RK                                           BH  82
  900 FORMAT (///,"  AN UNEXPECTED END OF FILE WAS ENCOUNTERED ON ",    BH  83
     1         //,"  THE AERODYNAMIC MATRIX TAPE ON UNIT ",I2,          BH  84
     2         //,"  WHILE SEARCHING FOR THE MATRIX FOR RK = ",E12.4 )  BH  85
C                                                                       BH  86
 1000 RETURN                                                            BH  87
      END                                                               BH  88
      OVERLAY(COMPAE,4,2)                                               BI   1
      PROGRAM UNSYCO                                                    BI   2
C                                                                       BI   3
C     SUBROUTINE TO COMPUTE THE STEADY AERODYNAMIC CHARACTERISTICS.     BI   4
C                                                                       BI   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  BI   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   BI   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)BI   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH  BI   9
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), BI  10
     1 ALPO(10), NBREAK(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  BI  11
     2 ETABAR(31,10),XIBAR(15,10), XIS(15,31,10), YBAR(15,10),          BI  12
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      BI  13
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  BI  14
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), BI  15
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            BI  16
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, IQT, IOPLU, IND    BI  17
C                                                                       BI  18
      COMMON /AEROC/  AC(70,20), D(100), F(100), CP(21), G(30), E(10),  BI  19
     1                XP(21)                                            BI  20
      COMMON /ALPVCT/ COEF(20,200), XF(200), YF(200), NFS(10), NFS1(10),BI  21
     1   GMASS(20,20), NSTRS, NMODES, DH, DW1, DW2, SPAN2(10),          BI  22
     2   TAN12(10), TAN22(10), CAVG2(10), XR(10), YR(10)                BI  23
C                                                                       BI  24
      COMMON /MATRIK/ C(70,70), ALPRS(2,70,20)                          BI  25
C                                                                       BI  26
      COMMON /COMMON/ DUM1(280)                                         BI  27
      COMMON /COMM/ DUM(12)                                             BI  28
      COMPLEX C, AC, D, CP, F                                           BI  29
      COMPLEX XCP(70), CLC(70)                                          BI  30
      EQUIVALENCE ( XCP(1), A(1) ), ( CLC(1), IA(1) )                   BI  31
C                                                                       BI  32
      IF ( DUM(12) .NE. 0.0 ) NALP = NMODES                             BI  33
      I2 = 0                                                            BI  34
      DO 50 IS=1,NSURF                                                  BI  35
      I1 = I2 + 1                                                       BI  36
      I2 = I2 + NW2(IS)                                                 BI  37
      IF ( DUM(12) .EQ. 0.0 ) GO TO 10                                  BI  38
C                                                                       BI  39
      CALL CALMDS ( XS(1,1,IS), YS(1,IS), BREF, NC(IS), NS(IS),         BI  40
     1              A, ALPRS(1,I1,1),B,+2, NST(IS), D, +10 )            BI  41
      GO TO 20                                                          BI  42
C                                                                       BI  43
   10 IF ( IDNWSH .NE. 0 ) GO TO 16                                     BI  44
C                                                                       BI  45
      DO 14 K=1,NALP                                                    BI  46
      READ (5,5) ( ALPRS(1,I,K), I=I1,I2 )                              BI  47
   14 READ (5,5) ( ALPRS(2,I,K), I=I1,I2 )                              BI  48
    5 FORMAT (6F10.0)                                                   BI  49
      GO TO 20                                                          BI  50
C                                                                       BI  51
   16 DO 18 K=1,NALP                                                    BI  52
      DO 18 I=I1,I2                                                     BI  53
      ALPRS(1,I,K) = 0.0                                                BI  54
   18 ALPRS(2,I,K) = 0.0                                                BI  55
C                                                                       BI  56
   20 DO 22 K=1,NALP                                                    BI  57
      DO 22 I=I1,I2                                                     BI  58
   22 ALPRS(1,I,K) = ALPRS(1,I,K) + ALPO(IS)                            BI  59
C                                                                       BI  60
      WRITE (6,24) IS                                                   BI  61
   24 FORMAT (1H1,17X," DOWNWASH VECTORS FOR SURFACE ", I2, // )        BI  62
C                                                                       BI  63
      DO 26 K=1,NALP                                                    BI  64
      WRITE (6,27) K, ( ALPRS(1,I,K), I=I1,I2 )                         BI  65
   26 WRITE (6,28)    ( ALPRS(2,I,K), I=I1,I2 )                         BI  66
   27 FORMAT (/,"    SLOPES FOR MODE NO. ",I2, //, ( 5E15.4 ) )         BI  67
   28 FORMAT (/,"    DEFLECTIONS", //, ( 5E15.4 ) )                     BI  68
C                                                                       BI  69
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 40                               BI  70
C                                                                       BI  71
      I3 = I2 + 1                                                       BI  72
      I2 = I2 + NS(IS)                                                  BI  73
      DO 30 K=1,NALP                                                    BI  74
      DO 30 I=I3,I2                                                     BI  75
      ALPRS(1,I,K) = 0.0                                                BI  76
   30 ALPRS(2,I,K) = 0.0                                                BI  77
C                                                                       BI  78
   40 CONTINUE                                                          BI  79
   50 CONTINUE                                                          BI  80
      M2 = I2                                                           BI  81
C                                                                       BI  82
      REWIND 1                                                          BI  83
      DO 2000 IK=1,NK                                                   BI  84
      RK2 = RK(IK)                                                      BI  85
C                                                                       BI  86
       CALL AECOEF ( AC, D, NW2, NS, NSURF, KSURF, NALP, RK2, BREF )    BI  87
C                                                                       BI  88
      IF ( IND .NE. 0 ) GO TO 3000                                      BI  89
C                                                                       BI  90
C                                                                       BI  91
      DO 1500 JA=1,NALP                                                 BI  92
C                                                                       BI  93
      IF ( IDUMP .NE. 0 ) WRITE (6,65) JA, (AC(I,JA), I=1,M2 )          BI  94
   65 FORMAT (1H1,19X,32H THE PRESSURE COEFICIENTS FOR                  BI  95
     1       ,//, 19X 20H       ALPHA VECTOR , I2, // (3X,5E15.7)  )    BI  96
C                                                                       BI  97
   70 FORMAT (1H1,19X,32H THE PRESSURE DISTRIBUTIONS FOR                BI  98
     1       ,//, 19X,20H       ALPHA VECTOR , I2        )              BI  99
   66 FORMAT (1H ,/,19X,17H     FREQUENCY = ,E11.4 )                    BI 100
      D(11) = 0.0                                                       BI 101
      D(12) = 0.0                                                       BI 102
      D(13) = 0.0                                                       BI 103
      D(14) = 0.0                                                       BI 104
      D(21) = 0.0                                                       BI 105
      D(22) = 0.0                                                       BI 106
      D(23) = 0.0                                                       BI 107
      D(24) = 0.0                                                       BI 108
C                                                                       BI 109
      I2 = 0                                                            BI 110
      DO 1000 IS=1,NSURF                                                BI 111
      WRITE (6,70) JA                                                   BI 112
      WRITE (6,66) RK(IK)                                               BI 113
      IF ( JSUROP .NE. 0 ) GO TO 76                                     BI 114
C                                                                       BI 115
      ICH = ICHORD(IS)                                                  BI 116
      LSP = LSPAN(IS)                                                   BI 117
      IST = ISTYPE(IS)                                                  BI 118
      GO TO 77                                                          BI 119
C                                                                       BI 120
   76 ICH = 1                                                           BI 121
      LSP = 5                                                           BI 122
      IST = 4                                                           BI 123
      IND = 0                                                           BI 124
C                                                                       BI 125
   77 I1 = I2 + 1                                                       BI 126
      I2 = I2 + NW2(IS)                                                 BI 127
      IF ( KSURF(IS,IS) .LT. 0 ) I2 = I2 + NS(IS)                       BI 128
      JR = 0                                                            BI 129
      DO 80 I=I1,I2                                                     BI 130
      JR = JR + 1                                                       BI 131
   80 F(JR) = AC(I,JA)*PI                                               BI 132
C                                                                       BI 133
      IF ( IOP2 .LT. -1 ) WRITE (6,67)                                  BI 134
   67 FORMAT (/,11X,48H *** PRESSURE DATA IN AMPLITUDE/PHASE FORMAT ***)BI 135
C                                                                       BI 136
      WRITE (6,90) IS                                                   BI 137
   90 FORMAT (//, 4X,21H LIFTING SURFACE NO. ,I2,/  )                   BI 138
      XP(1) = -0.95                                                     BI 139
      DO 100 I=2,21                                                     BI 140
  100 XP(I) = -1.0 + 0.1*(I-1)                                          BI 141
      XP(21) = 0.999                                                    BI 142
C                                                                       BI 143
      NC2 = NC(IS)                                                      BI 144
      NS3 = IABS( NS(IS) )                                              BI 145
      DO 170 IY=1,21                                                    BI 146
C                                                                       BI 147
      IF ( ISTYPE(IS) .GT. 2 ) GO TO 101                                BI 148
C                                                                       BI 149
      YP = 0.05*(IY-1)                                                  BI 150
      YPSO = SO(IS)*YP                                                  BI 151
      GO TO 102                                                         BI 152
C                                                                       BI 153
  101 YP = 0.1*(IY-1) - 1.0                                             BI 154
      YPSO = SO(IS)*0.05*(IY-1)                                         BI 155
C                                                                       BI 156
  102 SYP = SQRT(1.0 - YP*YP)                                           BI 157
C                                                                       BI 158
      CALL UNETA ( G, YP, 1, NS3, LSYM(IS), IST, LSP )                  BI 159
      IF ( ISTYPE(IS) .GT. 2 ) YP = 0.05*(IY-1)                         BI 160
      CALL XMBY ( XTE, BYP, YPSO, BRPT(1,1,IS), NEND(IS) )              BI 161
      IF ( BYP .NE. 0 ) GO TO 110                                       BI 162
C                                                                       BI 163
      WRITE (6,105) YP                                                  BI 164
  105 FORMAT ( //, "  THE CHORD AT YP =",E15.7," IS ZERO",// )          BI 165
      GO TO 170                                                         BI 166
C                                                                       BI 167
  110 B2 = SO(IS)/BYP                                                   BI 168
      IF (LSPAN(IS) .EQ. 1 ) B2 = B2*SYP                                BI 169
C                                                                       BI 170
      YPSO = 0.9999*YPSO                                                BI 171
C                                                                       BI 172
      IF ( JSUROP .NE. 0 ) CALL CHDTSS ( B, XP, XP, 21, ICHORD(IS),     BI 173
     1   LSPAN(IS), IND, 1, XMACH, BRPT(1,1,IS), YPSO, JSUROP )         BI 174
C                                                                       BI 175
      DO 150 IX=1,21                                                    BI 176
      MUNU = 0                                                          BI 177
      CALL TNXI ( E, XP(IX), 1, NC(IS), ICH )                           BI 178
      Q1   = SQRT( (1.0 - XP(IX))/(1.0 + XP(IX)) )                      BI 179
C                                                                       BI 180
  130 D(1) = 0.0                                                        BI 181
      DO 140 JI=1,NC2                                                   BI 182
      D(2) = 0.0                                                        BI 183
      DO 135 JR=1,NS3                                                   BI 184
      MUNU = MUNU + 1                                                   BI 185
  135 D(2) = D(2) + G(JR)*F(MUNU)                                       BI 186
  140 D(1) = D(1) + D(2)*E(JI)                                          BI 187
C                                                                       BI 188
      IF ( JSUROP .NE. 0 ) GO TO 145                                    BI 189
C                                                                       BI 190
      CP(IX) = 8.0*B2*D(1)*Q1                                           BI 191
      GO TO 150                                                         BI 192
C                                                                       BI 193
  145 CP(IX) = 8.0*D(1)*B(IX)                                           BI 194
C                                                                       BI 195
  150 CONTINUE                                                          BI 196
C                                                                       BI 197
      WRITE (6,160) YP                                                  BI 198
  160 FORMAT (1H ,/,25X,"SPAN STATION, YP=", F8.5, /,                   BI 199
     1 2("      XP             CP(XP,YP)          "), / )               BI 200
C                                                                       BI 201
      IF ( IOP2 .LT. -1 ) CALL POLAR ( CP, 21 )                         BI 202
C                                                                       BI 203
      WRITE (6,165) ( XP(IX), CP(IX), IX=1,21 )                         BI 204
  165 FORMAT (2(3X,F8.5,2E14.7) )                                       BI 205
C                                                                       BI 206
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 170                              BI 207
C                                                                       BI 208
      JR = NW2(IS)                                                      BI 209
      D(1) = 0.0                                                        BI 210
      DO 180 J=1,NS3                                                    BI 211
      JR = JR + 1                                                       BI 212
  180 D(1) = D(1) + G(J)*F(JR)                                          BI 213
      D(1) = D(1)*8.0*(AR(IS)**2)*BREF/SO(IS)                           BI 214
      IF ( LSPAN(IS) .EQ. 1 ) D(1) = D(1)*SQRT( 1.0 - YP*YP )           BI 215
C                                                                       BI 216
      IF ( IOP2 .LT. -1 ) CALL POLAR ( D(1), 1 )                        BI 217
C                                                                       BI 218
      WRITE (6,190) D(1)                                                BI 219
  190 FORMAT (/,"  SHOCK LOAD = ", 2E16.7, / )                          BI 220
C                                                                       BI 221
  170 CONTINUE                                                          BI 222
C                                                                       BI 223
C                                                                       BI 224
C     CALCULATION OF THE INTEGRATED CHARACTERISTICS                     BI 225
C                                                                       BI 226
      D(1) = 0.0                                                        BI 227
      D(2) = 0.0                                                        BI 228
      D(3) = 0.0                                                        BI 229
      NS2  = IABS(NSI(IS))                                              BI 230
      NC3  = IABS(NJ (IS))                                              BI 231
      B2   = 2.0*PI/(2.0*NC3+1.0)                                       BI 232
      IND = 0                                                           BI 233
      KS = ISTYPE(IS)                                                   BI 234
      GO TO ( 300, 300, 320, 330 ), KS                                  BI 235
  300 JS2 = 1 + NS2/2                                                   BI 236
      JS3 = NS2                                                         BI 237
      GO TO 380                                                         BI 238
  320 JS2 = 1                                                           BI 239
      JS3 = NS2/2                                                       BI 240
      GO TO 380                                                         BI 241
  330 JS2 = 1                                                           BI 242
      JS3 = NS2                                                         BI 243
C                                                                       BI 244
  380 KS = 0                                                            BI 245
      DO 500 JS=JS2,JS3                                                 BI 246
      KS = KS + 1                                                       BI 247
      S1 = SQRT(1.0-ETABAR(JS,IS)**2)                                   BI 248
      S2 = XISLTE(1,JS,IS) - ( XV(IS) - BO(IS)*BRINV )                  BI 249
      CALL UNETA ( G, ETABAR(JS,IS), 1, NS3, LSYM(IS), IST, LSP )       BI 250
C                                                                       BI 251
      YPSO = SO(IS)*ETABAR(JS,IS)                                       BI 252
      IF ( ISTYPE(IS) .GT. 1 ) YPSO = 0.5*( YPSO + SO(IS) )             BI 253
      IF ( JSUROP .NE. 0 ) CALL CHDTSS ( B, XIBAR(1,IS), XIBAR(1,IS),   BI 254
     1     NC3, ICHORD(IS), LSPAN(IS), IND, 0, XMACH, BRPT(1,1,IS),     BI 255
     2     YPSO, JSUROP )                                               BI 256
C                                                                       BI 257
      D(4) = 0.0                                                        BI 258
      D(5) = 0.0                                                        BI 259
C                                                                       BI 260
      DO 450 JJ=1,NC3                                                   BI 261
      CALL TNXI ( E, XIBAR(JJ,IS), 1, NC(IS), ICH )                     BI 262
      Q1 = B(JJ)                                                        BI 263
      IF ( JSUROP .EQ. 0 ) Q1 = 1.0 - XIBAR(JJ,IS)                      BI 264
      MUNU = 0                                                          BI 265
      D(7) = 0.0                                                        BI 266
      DO 400 JI=1,NC2                                                   BI 267
      D(6) = 0.0                                                        BI 268
C                                                                       BI 269
      DO 390 JR=1,NS3                                                   BI 270
      MUNU = MUNU + 1                                                   BI 271
  390 D(6) = D(6) + G(JR)*F(MUNU)                                       BI 272
  400 D(7) = D(7) + D(6)*E(JI)                                          BI 273
      D(7) = D(7)*Q1                                                    BI 274
      D(4) = D(4) + D(7)                                                BI 275
  450 D(5) = D(5) + D(7)*XIBAR(JJ,IS)                                   BI 276
C                                                                       BI 277
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 490                              BI 278
C                                                                       BI 279
      D(100) = 0.0                                                      BI 280
      JR = NW2(IS)                                                      BI 281
      DO 460 J=1,NS3                                                    BI 282
      JR = JR + 1                                                       BI 283
  460 D(100) = D(100) + G(J)*F(JR)                                      BI 284
      D(100) = D(100)*2*AR(IS)*BREF/(B2*SO(IS))                         BI 285
C                                                                       BI 286
      D(4)   = D(4) + D(100)                                            BI 287
      D(5)   = D(5) - D(100)                                            BI 288
C                                                                       BI 289
  490 D(8) = D(4)*B2                                                    BI 290
      IF ( LSP .EQ. 1 ) D(8) = D(8)*S1                                  BI 291
      IF ( JSUROP .NE. 0 ) D(8) = D(8)*BETABO(JS,IS)/SO(IS)             BI 292
      CLC(KS) = D(8)*4.0*AR(IS)                                         BI 293
      IF ( CABS(D(4)) .NE. 0.0 ) GO TO 495                              BI 294
      XCP(KS) = 0.0                                                     BI 295
      GO TO 496                                                         BI 296
  495 XCP(KS) = 0.5*CMPLX ( ( REAL(D(5))/REAL(D(4)) + 1.0 ),            BI 297
     1                      ( AIMAG(D(5))/AIMAG(D(4)) + 1.0 ) )         BI 298
  496 D(8)    = CLC(KS)*S1                                              BI 299
      IF ( JS .EQ. JS2 .AND. ISTYPE(IS) .LT. 3 ) D(8) = D(8)*0.5        BI 300
      D(1)  =  D(1) + D(8)                                              BI 301
      D(2) = D(2) + D(8)*ETABAR(JS,IS)                                  BI 302
      XCPR = REAL(XCP(KS))*2.0*BETABO(JS,IS) + S2                       BI 303
      XCPI = AIMAG(XCP(KS))*2.0*BETABO(JS,IS) + S2                      BI 304
C                                                                       BI 305
      D(3) = D(3) + CMPLX ( XCPR*REAL(D(8)), XCPI*AIMAG(D(8)) )         BI 306
C                                                                       BI 307
  500 CONTINUE                                                          BI 308
C                                                                       BI 309
  510 CP(1) = D(1)*PI/JS3                                               BI 310
C                                                                       BI 311
      IF ( ISTYPE(IS) .EQ. 3 ) CP(1) = CP(1)*0.5                        BI 312
C                                                                       BI 313
C                                                                       BI 314
  515 FRR = REAL(D(1))                                                  BI 315
      FRI = AIMAG(D(1))                                                 BI 316
C                                                                       BI 317
      IF ( CABS(D(1)) .NE. 0.0 ) GO TO 516                              BI 318
      CP(2) = 0.0                                                       BI 319
      CP(3) = 0.0                                                       BI 320
      GO TO 517                                                         BI 321
  516 CP(2) = CMPLX ( REAL(D(2))/FRR, AIMAG(D(2))/FRI )                 BI 322
      IF ( ISTYPE(IS) .GT. 2 ) CP(2) = 0.5*( CP(2) + CMPLX(1.0,1.0) )   BI 323
      CP(3) = CMPLX ( REAL(D(3))/FRR, AIMAG(D(3))/FRI )                 BI 324
  517 K0 = KS - 1                                                       BI 325
      IF ( ISTYPE(IS) .NE. 1 ) K0 = 0                                   BI 326
C                                                                       BI 327
C     CP(1) = LIFT COEFICIENT.                                          BI 328
C     CP(2) = SPANWISE CENTER OF PRESSURE, FRACTION OF SO(IS)           BI 329
C     CP(3) = CHORDWISE CENTER OF PRESSURE, FRACTION OF BO(IS) ABOUT    BI 330
C             LEADING EDGE APEX.                                        BI 331
C                                                                       BI 332
      WRITE (6,520) IS, RK(IK)                                          BI 333
  520 FORMAT (1H1,18X," INTEGRATED AERODYNAMIC RESULTS ",//             BI 334
     1           ,18X,"       FOR SURFACE NO. ", I2,     //             BI 335
     2           ,18X," REDUCED FREQUENCY = ", E11.4,    // )           BI 336
      IF (LS .EQ. 1) GO TO 531                                          BI 337
      WRITE (6,530) CP(1), CP(3), CP(2)                                 BI 338
  530 FORMAT(14X,"SYMMETRIC LIFT COEFFICIENT=",2E14.6,/,                BI 339
     1       14X,"XCPAVG=",2E14.6,/,14X,"YCPAVG=",2E14.6,//,            BI 340
     2       13X,47H  ETA             CLC/CAVG             XCP(ETA),/)  BI 341
      GO TO 533                                                         BI 342
  531 WRITE (6,532) CP(1), CP(3), CP(2)                                 BI 343
  532 FORMAT(14X,"ANTI-SYMMETRIC LIFT COEFFICIENT=",2E14.6,/,           BI 344
     1       14X,"XCPAVG=",2E14.6,/,14X,"YCPAVG=",2E14.6,//,            BI 345
     2       13X,47H  ETA             CLC/CAVG             XCP(ETA),/)  BI 346
  533 WRITE (6,540) ( ETABAR(JS+K0,IS), CLC(JS), XCP(JS), JS=1,KS )     BI 347
  540 FORMAT(11X,F8.5,3E14.6,E14.6)                                     BI 348
C                                                                       BI 349
      S2 = AREA(IS)                                                     BI 350
      S1 = XV(IS) - BO(IS)*BRINV                                        BI 351
      IF ( ISTYPE(IS) .EQ. 4 ) S2 = 0.5*S2                              BI 352
      COSTH = COS( THETA(IS) )                                          BI 353
      SINTH = SIN( THETA(IS) )                                          BI 354
C                                                                       BI 355
      IF ( ABS( COSTH ) .LT. 0.001 ) COSTH = 0.0                        BI 356
      IF ( ABS( SINTH ) .LT. 0.001 ) SINTH = 0.0                        BI 357
C                                                                       BI 358
      D(11) = D(11) + S2*COSTH                                          BI 359
      D(21) = D(21) + S2*SINTH                                          BI 360
      D(1)  = D(1)*S2*PI/JS3                                            BI 361
      IF ( ISTYPE(IS) .GT. 2 ) D(1) = D(1)*0.5                          BI 362
      D(12) = D(12) + D(1)*COSTH                                        BI 363
      D(22) = D(22) + D(1)*SINTH                                        BI 364
C                                                                       BI 365
      FRR = REAL(D(1))                                                  BI 366
      FRI = AIMAG(D(1))                                                 BI 367
C                                                                       BI 368
      CP(2) = SO(IS)*BRINV*CMPLX( (  FRR*REAL(CP(2)) ),                 BI 369
     1                            ( FRI*AIMAG(CP(2)) )  )               BI 370
C                                                                       BI 371
      D(13) = D(13) + CP(2)*COSTH + YV(IS)*D(1)                         BI 372
      D(23) = D(23) + CP(2)*SINTH + ZV(IS)*D(1)                         BI 373
C                                                                       BI 374
      CP(3) = CMPLX ( ( S1 +  REAL(CP(3)) )*FRR,                        BI 375
     1                ( S1 + AIMAG(CP(3)) )*FRI  )                      BI 376
C                                                                       BI 377
      D(14) = D(14) + CP(3)*COSTH                                       BI 378
      D(24) = D(24) + CP(3)*SINTH                                       BI 379
C                                                                       BI 380
 1000 CONTINUE                                                          BI 381
C                                                                       BI 382
      IF ( CABS(D(11)) .EQ. 0.0 .OR. CABS(D(12)) .EQ. 0.0 ) GO TO 1005  BI 383
C                                                                       BI 384
      CP(1) = D(12)/D(11)                                               BI 385
C                                                                       BI 386
      FRR = REAL(D(12))                                                 BI 387
      FRI = AIMAG(D(12))                                                BI 388
C                                                                       BI 389
      CP(2) = CMPLX ( REAL(D(13))/FRR, AIMAG(D(13))/FRI )               BI 390
      CP(3) = CMPLX ( REAL(D(14))/FRR, AIMAG(D(14))/FRI )               BI 391
      GO TO 1006                                                        BI 392
C                                                                       BI 393
 1005 CP(1) = 0.0                                                       BI 394
      CP(2) = 0.0                                                       BI 395
      CP(3) = 0.0                                                       BI 396
C                                                                       BI 397
 1006 WRITE (6,1010) CP(1), CP(3), CP(2)                                BI 398
 1010 FORMAT (1H1,//,14X,"THE INTEGRATED CONFIGURATION CHARACTERISTICS",BI 399
     1            //,14X,"    (A) VERTICAL COMPONENT, ALPHA ",          BI 400
     2            //,14X,"      CL  =", 2E15.7,                         BI 401
     3            //,14X,"      XCP =", 2E15.7,                         BI 402
     4            //,14X,"      YCP =", 2E15.7  )                       BI 403
C                                                                       BI 404
      IF (  CABS(D(21)) .EQ. 0.0 .OR.  CABS(D(22)) .EQ. 0.0) GO TO 1500 BI 405
C                                                                       BI 406
      CP(4) = D(22)/D(21)                                               BI 407
C                                                                       BI 408
      FRR = REAL(D(22))                                                 BI 409
      FRI = AIMAG(D(22))                                                BI 410
C                                                                       BI 411
      CP(5) = CMPLX ( REAL(D(23))/FRR, AIMAG(D(23))/FRI )               BI 412
      CP(6) = CMPLX ( REAL(D(24))/FRR, AIMAG(D(24))/FRI )               BI 413
C                                                                       BI 414
      WRITE (6,1020) CP(4), CP(6), CP(5)                                BI 415
 1020 FORMAT (1H ,//,14X,"    (B) LATERAL COMPONENT, BETA ",            BI 416
     1            //,14X,"      CL  =", 2E15.7,                         BI 417
     2            //,14X,"      XCP =", 2E15.7,                         BI 418
     3            //,14X,"      YCP =", 2E15.7   )                      BI 419
C                                                                       BI 420
 1500 CONTINUE                                                          BI 421
C                                                                       BI 422
 2000 CONTINUE                                                          BI 423
C                                                                       BI 424
C                                                                       BI 425
 3000 CONTINUE                                                          BI 426
      END                                                               BI 427
      SUBROUTINE POLAR ( C, N )                                         BJ   1
      COMPLEX C(N)                                                      BJ   2
      RADDEG = 45.0/ATAN(1.0)                                           BJ   3
C                                                                       BJ   4
      DO 10 I=1,N                                                       BJ   5
      AMP =  CABS( C(I) )                                               BJ   6
      R = REAL( C(I) )                                                  BJ   7
      A = AIMAG( C(I) )                                                 BJ   8
      IF ( R .NE. 0.0 .AND. A .NE. 0.0 ) GO TO 5                        BJ   9
      IF ( AMP .EQ. 0.0 ) PHASE = 0.0                                   BJ  10
      IF ( A .NE. 0.0 ) PHASE = SIGN( 90.0, A )                         BJ  11
      IF ( R .NE. 0.0 ) PHASE = 90.0 - SIGN( 90.0, R )                  BJ  12
      GO TO 10                                                          BJ  13
    5 PHASE = RADDEG*ATAN2( A, R )                                      BJ  14
   10 C(I) = CMPLX( AMP, PHASE )                                        BJ  15
C                                                                       BJ  16
      RETURN                                                            BJ  17
      END                                                               BJ  18
      OVERLAY(COMPAE,4,3)                                               BK   1
      PROGRAM QGENF                                                     BK   2
C                                                                       BK   3
C     SUBROUTINE TO CALCULATE GENERALIZED FORCES.                       BK   4
C                                                                       BK   5
      COMMON /MANE/ BREF, XMACH, BETA, BETA2, BRINV, LS, NW, PI, FREQ,  BK   6
     1 REFREQ(50), RK(50), NK, MARSHA, NALP, IA(140), IB(140), NSURF,   BK   7
     2 TAREA, A(140), B(140), JSUROP, IDUMP, IDNWSH, ICHORD(10), IXI(10)BK   8
     3 , ISTYPE(10), LSYM(10), LSPAN(10), BMACH(50,10), NST(10), HMACH  BK   9
      COMMON /MANE2/ BO(10), SO(10), XV(10), YV(10), ZV(10), THETA(10), BK  10
     1 ALPO(10), NBREAK(10), NEND(10), NBRPT(10), AR(10), ETAS(31,10),  BK  11
     2 ETABAR(31,10),XIBAR(15,10), XIS(15,31,10), YBAR(15,10),          BK  12
     3 YS(15,10), XBAR(10,10), XS(10,15,10), BYBO(15,10), NW2(10),      BK  13
     4 NC(10), NS(10), NJ(10), NSI(10), AREA(10), BOINV(10), KSURF(10,  BK  14
     5 10), BRPT(2,40,10), XISLTE(2,31,10), BETABO(31,10), SIGY(15,10), BK  15
     6 SIGETA(31,10), ZY(15,10), ZETA(31,10)                            BK  16
      COMMON /OPTION/ IOP1, IOP2, IOP3, IOP4, NUNIT, KQT, IOPLU, IND    BK  17
C                                                                       BK  18
      COMMON /AEROC/  AC(70,20), D(100), F(100), CP(21), G(30), E(10),  BK  19
     1                XP(21)                                            BK  20
      COMMON /ALPVCT/ COEF(20,200), XF(200), YF(200), NFS(10), NFS1(10),BK  21
     1   GMASS(20,20), NSTRS, NMODES, DH, DW1, DW2, SPAN2(10),          BK  22
     2   TAN12(10), TAN22(10), CAVG2(10), XR(10), YR(10)                BK  23
C                                                                       BK  24
      COMMON /MATRIK/ QRS(20,20), HRS(100,20), DUM2(7000),              BK  25
     1                ALPRS(2,70,20)                                    BK  26
C                                                                       BK  27
      COMMON /COMMON/ DUM1(280)                                         BK  28
      COMMON /COMM  / DUM(12)                                           BK  29
C                                                                       BK  30
      COMMON /TITLE / TLE(32)                                           BK  31
C                                                                       BK  32
      COMPLEX AC, D, CP, F, QRS                                         BK  33
C                                                                       BK  34
      IQT = IABS(KQT)                                                   BK  35
      IF ( IQT .EQ. 0 ) IQT = 4                                         BK  36
      REWIND IQT                                                        BK  37
      NQ2 = NMODES                                                      BK  38
      NQ = NQ2                                                          BK  39
      IF ( IOP2 .GT. 0 ) NQ  = IOP2                                     BK  40
C                                                                       BK  41
      IF ( IDNWSH .GE. 0 ) GO TO 2                                      BK  42
C                                                                       BK  43
      NQ = 1                                                            BK  44
      READ (5,5) UGUST, VFS, CONST                                      BK  45
      WRITE (6,3) UGUST, VFS, CONST                                     BK  46
    3 FORMAT (1H1,//,17X,35H GUST QRF TERMS WILL BE CALCULATED  ,       BK  47
     1            //,17X,28H      GUST VELOCITY (FPS) = , E14.7 ,       BK  48
     2             /,17X,28H      FREE STREAM V (FPS) = , E14.7 ,       BK  49
     3             /,17X,28H      MULT. CONST         = , E14.7   )     BK  50
C                                                                       BK  51
    2 IF (  KQT .EQ. 0 ) GO TO 1                                        BK  52
C                                                                       BK  53
      CALL STATUS (IA)                                                  BK  54
  950 REWIND IQT                                                        BK  55
      WRITE (IQT) IA(1), IA(3), ( IA(I), I=7,18 )                       BK  56
      WRITE (IQT) TLE                                                   BK  57
      WRITE (IQT) NK, NQ, NQ2, BREF, XMACH                              BK  58
      WRITE (IQT) ( IA(I), I=1,10 )                                     BK  59
      WRITE (IQT) ( RK(I), I=1,NK )                                     BK  60
C                                                                       BK  61
C     NEXT THE DOWNWASH VECTORS WILL BE CONSTRUCTED.                    BK  62
C                                                                       BK  63
    1 DO 2000 IK=1,NK                                                   BK  64
C                                                                       BK  65
      IF ( IK .NE. 1 .AND. IDNWSH .GE. 0 ) GO TO 56                     BK  66
      I2 = 0                                                            BK  67
      DO 50 IS=1,NSURF                                                  BK  68
      I1 = I2 + 1                                                       BK  69
      I2 = I2 + NW2(IS)                                                 BK  70
C                                                                       BK  71
      IF ( IDNWSH .GE. 0 ) GO TO 9                                      BK  72
C                                                                       BK  73
      C2 = CONST*UGUST/VFS                                              BK  74
      NX = NC(IS)                                                       BK  75
      NY = NS(IS)                                                       BK  76
      I = I1 - 1                                                        BK  77
      DO 8 K=1,NY                                                       BK  78
      DO 8 J=1,NX                                                       BK  79
      I = I+1                                                           BK  80
      ALPRS(1,I,1) = C2*COS( XS(J,K,IS)*RK(IK) )                        BK  81
    8 ALPRS(2,I,1) =-C2*SIN( XS(J,K,IS)*RK(IK) )*BREF/RK(IK)            BK  82
      GO TO 23                                                          BK  83
C                                                                       BK  84
    9 IF ( DUM(12) .EQ. 0.0 ) GO TO 10                                  BK  85
C                                                                       BK  86
      IF ( THETA(IS) .EQ. 0.0 ) GO TO 13                                BK  87
C                                                                       BK  88
      NY = NS(IS)                                                       BK  89
      DO 11 J=1,NY                                                      BK  90
   11 YS(J,IS) = ZY(J,IS)                                               BK  91
      NS2 = NSI(IS)                                                     BK  92
      DO 12 J=1,NS2                                                     BK  93
   12 ETAS(J,IS) = ZETA(J,IS)                                           BK  94
C                                                                       BK  95
   13 IF ( IOP2 .GT. 0 ) GO TO 10                                       BK  96
C                                                                       BK  97
      CALL CALMDS ( XS(1,1,IS), YS(1,IS), BREF, NC(IS), NS(IS),         BK  98
     1              A, ALPRS(1,I1,1), B, 2, NST(IS), D, +10   )         BK  99
      GO TO 20                                                          BK 100
C                                                                       BK 101
   10 IF ( IDNWSH .NE. 0 ) GO TO 16                                     BK 102
C                                                                       BK 103
      DO 14 K=1,NQ                                                      BK 104
      READ (5,5) ( ALPRS(1,I,K), I=I1,I2 )                              BK 105
   14 READ (5,5) ( ALPRS(2,I,K), I=I1,I2 )                              BK 106
    5 FORMAT ( 6F10.0 )                                                 BK 107
      GO TO 20                                                          BK 108
C                                                                       BK 109
   16 DO 18 K=1,NQ                                                      BK 110
      DO 18 I=I1,I2                                                     BK 111
      ALPRS(1,I,K) = 0.0                                                BK 112
   18 ALPRS(2,I,K) = 0.0                                                BK 113
C                                                                       BK 114
   20 DO 22 K=1,NQ                                                      BK 115
      DO 22 I=I1,I2                                                     BK 116
   22 ALPRS(1,I,K) = ALPRS(1,I,K) + ALPO(IS)                            BK 117
C                                                                       BK 118
   23 WRITE (6,24) IS                                                   BK 119
   24 FORMAT (1H1,17X," DOWNWASH VECTORS FOR SURFACE ", I2, // )        BK 120
C                                                                       BK 121
      DO 26 K=1,NQ                                                      BK 122
      WRITE (6,27) K, ( ALPRS(1,I,K), I=I1,I2 )                         BK 123
   26 WRITE (6,28)    ( ALPRS(2,I,K), I=I1,I2 )                         BK 124
   27 FORMAT (/,"    SLOPES FOR MODE NO. ",I2, //, ( 8E15.4 ) )         BK 125
   28 FORMAT (/,"    DEFLECTIONS", //,             ( 8E15.4 ) )         BK 126
C                                                                       BK 127
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 50                               BK 128
C                                                                       BK 129
      I3 = I2 + 1                                                       BK 130
      I2 = I2 + NS(IS)                                                  BK 131
      DO 30 K=1,NQ                                                      BK 132
      DO 30 I=I3,I2                                                     BK 133
      ALPRS(1,I,K) = 0.0                                                BK 134
   30 ALPRS(2,I,K) = 0.0                                                BK 135
C                                                                       BK 136
      WRITE (6,35) I3, I2                                               BK 137
   35 FORMAT (/,"    ROWS ",I3," THROUGH ", I3," ARE SET TO ZERO FOR ", BK 138
     1        /,"    NORMAL SHOCK BOUNDARY CONDITIONS. "  )             BK 139
C                                                                       BK 140
   50 CONTINUE                                                          BK 141
C                                                                       BK 142
      WRITE (6,55)                                                      BK 143
   55 FORMAT (1H1)                                                      BK 144
   56 RK2 = RK(IK)                                                      BK 145
C                                                                       BK 146
C     NEXT, THE PRESSURE SERIES COEFICIENTS WILL BE CALCULATED          BK 147
C     FOR THE NQ DOWNWASH VECTORS AT THE BEGINNING OF THE FREQUENCY     BK 148
C     LOOP FOR NK FREQUENCIES.                                          BK 149
C                                                                       BK 150
      CALL AECOEF ( AC, D, NW2, NS, NSURF, KSURF, NQ, RK2, BREF )       BK 151
      IF ( IND .NE. 0 ) GO TO 3000                                      BK 152
C                                                                       BK 153
C     THE GENERALIZED FORCES WILL BE CALCULATED IN ARRAY QRS AND        BK 154
C     WRITTEN ON TAPE IQT.                                              BK 155
C                                                                       BK 156
      IF ( KQT .LT.0 ) GO TO 70                                         BK 157
C                                                                       BK 158
      DO 60 J=1,NQ                                                      BK 159
      DO 60 I=1,NQ2                                                     BK 160
   60 QRS(I,J) = ( 0.0, 0.0 )                                           BK 161
      GO TO 90                                                          BK 162
C                                                                       BK 163
   70 READ ( 4 ) ( ( QRS(I,J), I=1,NQ2 ), J=1,NQ )                      BK 164
C                                                                       BK 165
   90 I2 = 0                                                            BK 166
      DO 1000 IS=1,NSURF                                                BK 167
      I1 = I2 + 1                                                       BK 168
      I2 = I2 + NW2(IS)                                                 BK 169
      IF ( KSURF(IS,IS) .LT. 0 ) I2 = I2 + NS(IS)                       BK 170
      IF ( JSUROP .NE. 0 ) GO TO 94                                     BK 171
C                                                                       BK 172
      ICH = ICHORD(IS)                                                  BK 173
      LSP = LSPAN(IS)                                                   BK 174
      IST = ISTYPE(IS)                                                  BK 175
      GO TO 95                                                          BK 176
C                                                                       BK 177
   94 ICH = 1                                                           BK 178
      LSP = 5                                                           BK 179
      IST = 4                                                           BK 180
C                                                                       BK 181
   95 IND = 0                                                           BK 182
      MBAR = NC(IS)                                                     BK 183
      NR   = NS(IS)                                                     BK 184
      JJ   = NJ(IS)                                                     BK 185
      NS2  = NSI(IS)                                                    BK 186
      KS   = ISTYPE(IS)                                                 BK 187
      GO TO ( 100, 100, 120, 130 ), KS                                  BK 188
  100 JS2 = 1 + NS2/2                                                   BK 189
      JS3 = NS2                                                         BK 190
      GO TO 140                                                         BK 191
  120 JS2 = 1                                                           BK 192
      JS3 = NS2/2                                                       BK 193
      GO TO 140                                                         BK 194
  130 JS2 = 1                                                           BK 195
      JS3 = NS2                                                         BK 196
C                                                                       BK 197
  140 B2 = 8.0*( ( PI*SO(IS))**2 )/(JS3*BREF)                           BK 198
      IF ( ISTYPE(IS) .GT. 2 ) B2 = B2*0.5                              BK 199
      IF ( IDNWSH     .LT. 0 ) B2 = B2/12.0                             BK 200
C                                                                       BK 201
      B1 = B2*PI*2.0/( 2.0*JJ+1.0 )                                     BK 202
      B4 = B2*2.0*BREF*AR(IS)/SO(IS)                                    BK 203
C                                                                       BK 204
      IF ( ISTYPE(IS) .NE. 4 ) GO TO 190                                BK 205
      B1 = 0.5*B1                                                       BK 206
      B2 = 0.5*B2                                                       BK 207
C                                                                       BK 208
  190 DO 500 JS=JS2,JS3                                                 BK 209
      S1 = SQRT( 1.0 - ETABAR(JS,IS)**2 )                               BK 210
      IF ( LSP .EQ. 1 ) S1 = S1*S1                                      BK 211
      IF ( JSUROP .NE. 0 ) S1 =     ( S1 )*BETABO(JS,IS)/SO(IS)         BK 212
      B3 = S1*B1                                                        BK 213
C                                                                       BK 214
      CALL UNETA ( G, ETABAR(JS,IS), 1, NR, LSYM(IS), IST, LSP )        BK 215
C                                                                       BK 216
      IF ( JSUROP .EQ. 0 ) GO TO 385                                    BK 217
      YPSO = SO(IS)*ETABAR(JS,IS)                                       BK 218
      IF ( ISTYPE(IS) .GT. 1 ) YPSO = 0.5*( YPSO + SO(IS) )             BK 219
      CALL CHDTSS ( B, XIBAR(1,IS), XIBAR(1,IS), NC3, ICHORD(IS),       BK 220
     1  LSPAN(IS), IND, 0, XMACH, BRPT(1,1,IS), YPSO, JSUROP )          BK 221
C                                                                       BK 222
  385 CALL CALMDS ( XIS(1,JS,IS), ETAS(JS,IS), BREF, JJ, 1,             BK 223
     1              A, B, HRS, +3, NST(IS), D, +15 )                    BK 224
C                                                                       BK 225
      DO 400 J=1,JJ                                                     BK 226
      CALL TNXI ( E, XIBAR(J,IS), 1, MBAR, ICH )                        BK 227
      Q1 = B3*( 1.0 - XIBAR(J,IS) )                                     BK 228
      IF ( JSUROP .NE. 0 ) Q1 = B3*B(JJ)                                BK 229
C                                                                       BK 230
      IF ( JS .EQ. JS2 .AND. ISTYPE(IS) .LT. 3 ) Q1 = Q1*0.5            BK 231
C                                                                       BK 232
      DO 300 JQ=1,NQ                                                    BK 233
C                                                                       BK 234
      D(1) = (0.0,0.0)                                                  BK 235
      MUNU = I1 - 1                                                     BK 236
      DO 210 JI=1,MBAR                                                  BK 237
      D(2) = (0.0,0.0)                                                  BK 238
      DO 200 JR=1,NR                                                    BK 239
      MUNU = MUNU + 1                                                   BK 240
  200 D(2) = D(2) + G(JR)*AC(MUNU,JQ)                                   BK 241
  210 D(1) = D(1) + D(2)*E(JI)                                          BK 242
      D(1) = D(1)*Q1                                                    BK 243
      DO 300 IQ=1,NQ2                                                   BK 244
  300 QRS(IQ,JQ) = QRS(IQ,JQ) + D(1)*HRS(J,IQ)                          BK 245
C                                                                       BK 246
  400 CONTINUE                                                          BK 247
C                                                                       BK 248
      IF ( KSURF(IS,IS) .GE. 0 ) GO TO 500                              BK 249
C                                                                       BK 250
      CALL CALMDS ( XISLTE(1,JS,IS), ETAS(JS,IS), BREF, 1, 1,           BK 251
     1              A, B, HRS,  +3, NST(IS), D, +2 )                    BK 252
C                                                                       BK 253
      Q1 = S1*B4                                                        BK 254
C                                                                       BK 255
      IF ( JS .EQ. JS2 .AND. ISTYPE(IS) .LT. 3 ) Q1 = Q1*0.5            BK 256
C                                                                       BK 257
      DO 450 JQ=1,NQ                                                    BK 258
C                                                                       BK 259
      D(1) = (0.0,0.0)                                                  BK 260
      I4 = MUNU                                                         BK 261
      DO 410 JR=1,NR                                                    BK 262
      I4 = I4 + 1                                                       BK 263
  410 D(1) = D(1) + G(JR)*AC(I4,JQ)                                     BK 264
      D(1) = D(1)*Q1                                                    BK 265
C                                                                       BK 266
      DO 450 IQ=1,NQ2                                                   BK 267
  450 QRS(IQ,JQ) = QRS(IQ,JQ) + D(1)*HRS(1,IQ)                          BK 268
C                                                                       BK 269
  500 CONTINUE                                                          BK 270
C                                                                       BK 271
 1000 CONTINUE                                                          BK 272
C                                                                       BK 273
      WRITE (IQT) ( ( QRS(I,J), I=1,NQ2 ), J=1,NQ )                     BK 274
C                                                                       BK 275
C                                                                       BK 276
 1009 WRITE ( 6,1010 ) RK2                                              BK 277
 1010 FORMAT (//,37H     THE GENERALIZED FORCES FOR K =  ,E11.4, / )    BK 278
      DO 1020 J=1,NQ                                                    BK 279
 1020 WRITE ( 6,1030 ) J, ( QRS(I,J), I=1,NQ2 )                         BK 280
 1030 FORMAT (/, 25H         PRESSURE MODE =  , I2, //, ( 8E15.6 ) )    BK 281
C                                                                       BK 282
 2000 CONTINUE                                                          BK 283
C                                                                       BK 284
      END FILE IQT                                                      BK 285
      REWIND IQT                                                        BK 286
C                                                                       BK 287
 3000 CONTINUE                                                          BK 288
      END                                                               BK 289
